Theory Phi_Type

theory Phi_Type
  imports IDE_CP_Reasoning2
  keywords "φtype_def" "φproperty_deriver" "let_φtype" "φtypeclass" :: thy_defn
       and "deriving" "parameter_equality" :: quasi_command
begin

chapter ‹The Algebra of ‹φ›-Type›

section ‹Algebraic Properties of φ-Types›

subsection ‹Auxiliary Preliminaries›

subsubsection ‹Conditioned Operators›

definition cond_splitR ("?sR") ― ‹conditioned module split at right›
  where ‹?sR C f = (if C then f else (λx. (x, unspec))) ›

definition cond_splitL ("?sL") ― ‹conditioned module split at left›
  where ‹?sL C f = (if C then f else (λx. (unspec, x))) ›

abbreviation cond_splitR' ("?sR[_]" [30] 1000)
  where ‹?sR[C] ≡ ?sR (LPR_ctrl C)›

abbreviation cond_splitL' ("?sL[_]" [30] 1000)
  where ‹?sL[C] ≡ ?sL (LPR_ctrl C)›

lemma cond_split_red[simp, φsafe_simp]:
  ‹?sR True f = f›
  ‹?sR False f = (λx. (x, unspec))›
  ‹?sL True g = g›
  ‹?sL False g = (λx. (unspec, x))›
  unfolding cond_splitR_def cond_splitL_def
  by simp_all

definition cond_unionR ("?jR") ― ‹conditioned module split at right›
  where ‹?jR C f = (if C then f else fst) ›

definition cond_unionL ("?jL") ― ‹conditioned module split at left›
  where ‹?jL C f = (if C then f else snd) ›

abbreviation cond_unionR' ("?jR[_]" [30] 1000)
  where ‹?jR[C] ≡ ?jR (LPR_ctrl C)›

abbreviation cond_unionL' ("?jL[_]" [30] 1000)
  where ‹?jL[C] ≡ ?jL (LPR_ctrl C)›

lemma cond_union_red[simp, φsafe_simp]:
  ‹?jR True f = f›
  ‹?jR False f = fst›
  ‹?jL True g = g›
  ‹?jL False g = snd›
  unfolding cond_unionR_def cond_unionL_def
  by simp_all

lemma cond_union_simp[simp, φsafe_simp]:
  ‹?jR C fst = fst›
  unfolding LPR_ctrl_def cond_unionR_def
  by simp_all


definition cond_mapper :: ‹bool ⇒ (('a ⇒ 'b) ⇒ 'c ⇒ 'd)
                                ⇒ (('a ⇒ 'b) ⇒ 'c ⇒ 'd)› ("?M")
  where ‹?M C m = (if C then m else (λ_ _. unspec))›

abbreviation cond_mapper' ("?M[_]" [30] 1000)
  where ‹?M[C] ≡ ?M (LPR_ctrl C)›

lemma cond_mapper_red[simp, φsafe_simp]:
  ‹?M True m = m›
  ‹?M False m f = (λ_. unspec)›
  unfolding cond_mapper_def
  by simp_all

lemma cond_mapper_simp[simp, φsafe_simp]:
  ‹?M C (λ_ _. unspec) = (λ_ _. unspec)›
  unfolding LPR_ctrl_def cond_mapper_def
  by simp_all

paragraph ‹mapToA_assign_id›

lemma [φreason %mapToA_assign_id+10]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] C
⟹ mapToA_assign_id (m f)
⟹ mapToA_assign_id (?M C m f) ›
  unfolding mapToA_assign_id_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason %mapToA_assign_id+20]:
  ‹ mapToA_assign_id (m f)
⟹ mapToA_assign_id (?M[True] m f) ›
  unfolding mapToA_assign_id_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason %mapToA_assign_id+30 for ‹mapToA_assign_id (?M _ _ _ :: unit ⇒ unit)›
                                        ‹mapToA_assign_id (?M[False] _ _ :: ?'a ⇒ ?'a)›,
       φreason %mapToA_assign_id    for ‹mapToA_assign_id (?M _ _ _ :: ?'a ⇒ ?'a)›]:
  ‹mapToA_assign_id (?M C m f :: unit ⇒ unit) ›
  unfolding mapToA_assign_id_def
  by (clarsimp simp: fun_eq_iff)

lemma [φreason %lookup_a_mapper]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] C
⟹ IDE_CP_Reasoning2.lookup_a_mapper (m f) x y
⟹ IDE_CP_Reasoning2.lookup_a_mapper (?M C m f) x y ›
  unfolding IDE_CP_Reasoning2.lookup_a_mapper_def Premise_def 𝗋Guard_def
  by simp

lemma [φreason %lookup_a_mapper+10]:
  ‹ IDE_CP_Reasoning2.lookup_a_mapper (m f) x y
⟹ IDE_CP_Reasoning2.lookup_a_mapper (?M[True] m f) x y ›
  unfolding IDE_CP_Reasoning2.lookup_a_mapper_def
  by simp

lemma [φreason %lookup_a_mapper+10]:
  ‹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y' : y
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 y' = unspec
⟹ IDE_CP_Reasoning2.lookup_a_mapper (?M[False] m f) x y ›
  unfolding IDE_CP_Reasoning2.lookup_a_mapper_def Premise_def Simplify_def
  by simp


subsubsection ‹Conditioned Zip \& Unzip›

definition cond_zip ("?Z")
  where ‹?Z C z mapper = (if C then z else mapper (λx. (x, unspec)) o fst)›

definition cond_zip2 ("?Z2")
  where ‹?Z2 C z mapper = (if C then z else mapper (λx. (x, unspec)) (λx. (x, unspec)) o fst)›

definition cond_zip_dom ("?ZD")
  where ‹?ZD C D D' R' = (if C then D else {x. ∀a. a ∈ D' (fst x) ⟶ (a, unspec) ∈ R' (fst x)})›

definition cond_zip_dom2 ("?ZD2")
  where ‹?ZD2 C D D'1 D'2 R'1 R'2 = (
    if C then D else {x. (∀a. a ∈ D'1 (fst x) ⟶ (a, unspec) ∈ R'1 (fst x)) ∧
                         (∀a. a ∈ D'2 (fst x) ⟶ (a, unspec) ∈ R'2 (fst x)) })›

definition cond_unzip ("?UZ")
  where ‹?UZ C uz mapper = (if C then uz else (λx. (mapper fst x, unspec)))›

definition cond_unzip_dom ("?UZD")
  where ‹?UZD C D1 D2 R' = (if C then D1 else {x. ∀(a,b) ∈ D2 x. a ∈ R' x})›


abbreviation cond_zip' ("?Z[_]" [30] 1000)
  where ‹?Z[C] ≡ ?Z (LPR_ctrl C)›

abbreviation cond_zip'2 ("?Z2[_]" [30] 1000)
  where ‹?Z2[C] ≡ ?Z2 (LPR_ctrl C)›

abbreviation cond_zip_dom' ("?ZD[_]" [30] 1000)
  where ‹?ZD[C] ≡ ?ZD (LPR_ctrl C)›

abbreviation cond_zip_dom'2 ("?ZD2[_]" [30] 1000)
  where ‹?ZD2[C] ≡ ?ZD2 (LPR_ctrl C)›

abbreviation cond_unzip' ("?UZ[_]" [30] 1000)
  where ‹?UZ[C] ≡ ?UZ (LPR_ctrl C)›

abbreviation cond_unzip_dom' ("?UZD[_]" [30] 1000)
  where ‹?UZD[C] ≡ ?UZD (LPR_ctrl C)›



paragraph ‹Basic Rules›

lemma cond_zip_red[simp, φsafe_simp]:
  ‹ ?Z True z mapper = z ›
  ‹ ?Z False z mapper = mapper (λx. (x, unspec)) o fst ›
  unfolding cond_zip_def
  by simp_all

lemma cond_zip2_red[simp, φsafe_simp]:
  ‹ ?Z2 True z mapper = z ›
  ‹ ?Z2 False z mapper = mapper (λx. (x, unspec)) (λx. (x, unspec)) o fst ›
  unfolding cond_zip2_def
  by simp_all

lemma cond_zip_dom_red[simp, φsafe_simp]:
  ‹ ?ZD True D D' R' = D ›
  ‹ ?ZD False D D' R' = {x. ∀a. a ∈ D' (fst x) ⟶ (a, unspec) ∈ R' (fst x)} ›
  unfolding cond_zip_dom_def
  by simp_all

lemma cond_zip_dom2_red[simp, φsafe_simp]:
  ‹ ?ZD2 True D D'1 D'2 R'1 R'2 = D ›
  ‹ ?ZD2 False D D'1 D'2 R'1 R'2 =
            {x. (∀a. a ∈ D'1 (fst x) ⟶ (a, unspec) ∈ R'1 (fst x)) ∧
                (∀a. a ∈ D'2 (fst x) ⟶ (a, unspec) ∈ R'2 (fst x)) } ›
  unfolding cond_zip_dom2_def
  by simp_all

lemma cond_unzip_red[simp, φsafe_simp]:
  ‹ ?UZ True uz m = uz ›
  ‹ ?UZ False uz m x = (m fst x, unspec) ›
  unfolding cond_unzip_def
  by simp_all

lemma cond_unzip[simp, φsafe_simp]:
  ‹ fst (uz x) = m fst x
⟹ fst (?UZ flag uz m x) = m fst x ›
  unfolding cond_unzip_def
  by clarsimp

lemma cond_unzip_dom_red[simp, φsafe_simp]:
  ‹ ?UZD True D1 D2 R' = D1 ›
  ‹ ?UZD False D1 D2 R' = {x. ∀(a,b) ∈ D2 x. a ∈ R' x} ›
  unfolding cond_unzip_dom_def
  by simp_all

lemma cond_unzip_dom_simp[simp, φsafe_simp]:
  ‹ ?UZD C UNIV (λ_. {}) R' = UNIV ›
  ‹ ?UZD C UNIV D' (λ_. UNIV) = UNIV ›
  unfolding cond_unzip_dom_def
  by simp_all

lemma cond_zip_dom_simp[simp, φsafe_simp]:
  ‹ ?ZD C UNIV (λ_. {}) R' = UNIV ›
  ‹ ?ZD C UNIV D' (λ_. UNIV) = UNIV ›
  ‹ x ∈ ?ZD C D D' (λ_. UNIV) ⟷ (C ⟶ x ∈ D) ›
  ‹ x ∈ ?ZD C D (λ_. {}) R' ⟷ (C ⟶ x ∈ D) ›
  unfolding cond_zip_dom_def
  by simp_all

lemma cond_zip_dom2_simp[simp, φsafe_simp]:
  ‹ ?ZD2 C UNIV (λ_. {}) (λ_. {}) R'1 R'2 = UNIV ›
  ‹ ?ZD2 C UNIV D'1 D'2 (λ_. UNIV) (λ_. UNIV) = UNIV ›
  ‹ x ∈ ?ZD2 C D D'1 D'2 (λ_. UNIV) (λ_. UNIV) ⟷ (C ⟶ x ∈ D) ›
  ‹ x ∈ ?ZD2 C D (λ_. {}) (λ_. {}) R'1 R'2 ⟷ (C ⟶ x ∈ D) ›
  unfolding cond_zip_dom2_def
  by simp_all


subsubsection ‹Separatable Mapping› ― ‹those used in transformation mapper›

definition separatable_unzip
  where ‹separatable_unzip z uz Du m m1 m2 f g ⟷
          (∀x∈Du. z (map_prod (m1 f) (m2 g) (uz x)) = m (map_prod f g) x) ›

definition separatable_cond_unzip
  where ‹separatable_cond_unzip C z uz Du m m1 m2 f g ⟷
          ((¬C ⟶ g = (λ_. unspec)) ⟶ separatable_unzip z uz Du m m1 m2 f g)›

definition separatable_zip
  where ‹separatable_zip uz z Dz m m1 m2 f g ⟷
          (∀x∈Dz. uz (m (map_prod f g) (z x)) = map_prod (m1 f) (m2 g) x)›

definition separatable_cond_zip
  where ‹separatable_cond_zip C uz z Dz m m1 m2 f g ⟷
          ((¬C ⟶ g = (λ_. unspec)) ⟶ separatable_zip uz z Dz m m1 m2 f g)›


definition compositional_mapper
  where ‹compositional_mapper m1 m2 m3 D f g ⟷
          (∀x ∈ D. m1 f (m2 g x) = m3 (f o g) x)›

definition domain_of_inner_map
  where ‹domain_of_inner_map mapper Di ⟷
          (∀f g x. (∀a ∈ Di x. f a = g a) ⟶ mapper f x = mapper g x)›

definition domain_by_mapper
  where ‹domain_by_mapper D' m D f Dx ⟷ (∀x∈Dx. D' (m f x) ⊆ f ` D x)›

definition separatable_module_zip
  where ‹separatable_module_zip flag d a b c uz' z' uz z D fb fc fd fa ⟷
            (∀x. D x ((fb ⊗f fc o uz b c o z d a) x) ⟶
                 (if flag then dabc_equation d a b c else dabc_equation b c d a) ⟶
                 (uz' d a o z' b c o fb ⊗f fc o uz b c o z d a) x = (fd ⊗f fa) x)›

definition module_mapper1ε
  where ‹module_mapper1ε ε eε iε DεE DεI D f f'
            ⟷ (∀x. D x ⟶ iε (f (eε x)) = f' x ∧ DεE x ∧ DεI (f (eε x)) ) ›

definition module_mapper22
  where ‹module_mapper22 flag d a b c sp' jn' sp jn Dsp' Djn' Dsp Djn DM fc fb fa fd ⟷
    (∀x. DM x ⟶
         (if flag then dabc_equation d a b c else dabc_equation b c d a) ⟶
         (let (xa,xd) = x
            ; (xc,xb) = sp c b (jn a d (xa,xd))
            ; (yc,yb) = (fc xc, fb xb)
            ; (ya,yd) = sp' a d (jn' c b (yc,yb))
           in (ya,yd) = (fa xa, fd xd) ∧
              Djn a d (xa,xd) ∧
              Dsp c b (jn a d (xa,xd)) ∧
              Djn' c b (yc,yb) ∧
              Dsp' a d (jn' c b (yc,yb))
))›


definition module_mapper13C
  where ‹module_mapper13C Cc Cd d a da c sp jn Dsp Djn D fd fa fc f g ⟷
    (∀x. D x ⟶
         ?+ True da = ?+ Cd d + ?+ True a ∧ (Cc ⟶ da ##+ c) ∧ (Cd ⟶ d ##+ a) ⟶
         (let (xa,xd,xc) = x
            ; y = f (?jR Cc (jn da c) (?jL Cd (jn d a) (xd, xa), xc))
            ; (yda,yc) = ?sR Cc (sp da c) y
            ; (yd,ya) = ?sL Cd (sp d a) yda
           in g x = ?jR Cc (jn da c) (?jL Cd (jn d a) (xd, xa), xc) ∧
              (ya,yc,yd) = (fa xa, fc xc, fd xd) ∧
              (Cd ⟶ Djn d a (xd, xa) ∧
                      Dsp d a yda) ∧
              (Cc ⟶ Djn da c (?jL Cd (jn d a) (xd, xa), xc) ∧
                      Dsp da c y)))›


definition module_mapper13
  where ‹module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g ⟷
    (∀x. D x ⟶
         d+a ##+ c ∧ d ##+ a ⟶
         (let (xa,xd,xc) = x
            ; y = f (jn (d+a) c (jn d a (xd, xa), xc))
            ; (yda,yc) = sp (d+a) c y
            ; (yd,ya) = sp d a yda
           in g x = jn (d+a) c (jn d a (xd, xa), xc) ∧
              (ya,yc,yd) = (fa xa, fc xc, fd xd) ∧
              Djn d a (xd, xa) ∧ Dsp d a yda ∧
              Djn (d+a) c (jn d a (xd, xa), xc) ∧ Dsp (d+a) c y))›

definition module_mapper12L
  where ‹module_mapper12L d a sp jn Dsp Djn D fd fa f ⟷
    (∀x. D x ⟶
         d ##+ a ⟶
         (let (xd,xa) = x
            ; y = f (jn d a (xd,xa))
            ; (yd,ya) = sp d a y
           in (yd,ya) = (fd xd, fa xa) ∧
              Djn d a (xd,xa) ∧ Dsp d a y))›

definition module_mapper12R
  where ‹module_mapper12R a c sp jn Dsp Djn D fa fc f ⟷
    (∀x. D x ⟶
         a ##+ c ⟶
         (let (xa,xc) = x
            ; y = f (jn a c (xa, xc))
            ; (ya,yc) = sp a c y
           in (ya,yc) = (fa xa, fc xc) ∧ Djn a c (xa, xc) ∧ Dsp a c y))›

definition module_mapper31C
  where ‹module_mapper31C Cc Cd c b db d sp jn Dsp Djn D fc f fd f' g ⟷
    (∀x. D x ⟶
         (?+ True db = ?+ Cd d + ?+ True b) ∧ (Cc ⟶ db ##+ c) ∧ (Cd ⟶ d ##+ b) ⟶
             (let (xdb, xc) = ?sR Cc (sp db c) x
                ; (xd, xb) = ?sL Cd (sp d b) xdb
               in g x = (xd, xb, xc) ∧
                  (((?jR Cc (jn db c) o apfst (?jL Cd (jn d b))) o
                    ((fd ⊗f f) ⊗f fc) o
                    (apfst (?sL Cd (sp d b)) o ?sR Cc (sp db c))) x = f' x) ∧
                  (Cd ⟶ Djn d b (fd xd, f xb) ∧ Dsp d b xdb) ∧
                  (Cc ⟶ Djn db c (?jL Cd (jn d b) (fd xd, f xb), fc xc) ∧
                          Dsp db c x)))›

definition module_mapper31
  where ‹module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g ⟷
    (∀x. D x ⟶ (let (xdb, xc) = sp (d+b) c x
                    ; (xd, xb) = sp d b xdb
                   in g x = (xd, xb, xc) ∧
                      (((jn (d+b) c o apfst (jn d b)) o
                        ((fd ⊗f f) ⊗f fc) o
                        (apfst (sp d b) o sp (d+b) c)) x = f' x) ∧
                      Djn d b (fd xd, f xb) ∧ Dsp d b xdb ∧
                      Djn (d+b) c (jn d b (fd xd, f xb), fc xc) ∧
                      Dsp (d+b) c x))›

definition module_mapper21R
  where ‹module_mapper21R b c sp jn Dsp Djn D fc f f' ⟷
    (∀x. D x ⟶
         b ##+ c ⟶
         (let (xb, xc) = sp b c x
           in ((jn b c o f ⊗f fc o sp b c) x = f' x) ∧
              Djn b c (f xb, fc xc) ∧
              Dsp b c x))›

definition module_mapper21L
  where ‹module_mapper21L b d sp jn Dsp Djn D f fd f' ⟷
    (∀x. D x ⟶
         d ##+ b ⟶
        (let (xd, xb) = sp d b x
          in ((jn d b o fd ⊗f f o sp d b) x = f' x) ∧
             Djn d b (fd xd, f xb) ∧ Dsp d b x))›

definition module_mapper3εC
  where ‹module_mapper3εC Cc Cd c ε dε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g ⟷
    (∀x. D x ⟶
         (?+ True dε = ?+ Cd d + ?+ True ε) ∧ (Cc ⟶ dε ##+ c) ∧ (Cd ⟶ d ##+ ε) ⟶
         (let (xdε, xc) = ?sR Cc (sp dε c) x
            ; (xd, xε) = ?sL Cd (sp d ε) xdε
           in g x = (xd, eε xε, xc) ∧
              (((?jR Cc (jn dε c) o apfst (?jL Cd (jn d ε))) o
                ((fd ⊗f (iε o f o eε)) ⊗f fc) o
                (apfst (?sL Cd (sp d ε)) o ?sR Cc (sp dε c))) x = f' x) ∧
              DεE xε ∧ DεI (f (eε xε)) ∧
              (Cd ⟶ Djn d ε (fd xd, iε (f (eε xε))) ∧ Dsp d ε xdε) ∧
              (Cc ⟶ Djn dε c (?jL Cd (jn d ε) (fd xd, iε (f (eε xε))), fc xc) ∧
                      Dsp dε c x)))›

definition module_mapper3ε
  where ‹module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g ⟷
    (∀x. D x ⟶ (let (xdε, xc) = sp (d+ε) c x
                    ; (xd, xε) = sp d ε xdε
                   in g x = (xd, eε xε, xc) ∧
                      (((jn (d+ε) c o apfst (jn d ε)) o
                        ((fd ⊗f (iε o f o eε)) ⊗f fc) o
                        (apfst (sp d ε) o sp (d+ε) c)) x = f' x) ∧
                      DεE xε ∧ DεI (f (eε xε)) ∧
                      Djn d ε (fd xd, iε (f (eε xε))) ∧ Dsp d ε xdε ∧
                      Djn (d+ε) c (jn d ε (fd xd, iε (f (eε xε))), fc xc) ∧
                      Dsp (d+ε) c x))›

definition module_mapper2εR
  where ‹module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g ⟷
    (∀x. D x ⟶ (let (xε, xc) = sp ε c x
                   in g x = (eε xε, xc) ∧
                      ((jn ε c o (iε o f o eε) ⊗f fc o sp ε c) x = f' x) ∧
                      DεE xε ∧ DεI (f (eε xε)) ∧
                      Djn ε c (iε (f (eε xε)), fc xc) ∧
                      Dsp ε c x))›

definition module_mapper2εL
  where ‹module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g ⟷
    (∀x. D x ⟶
         d ##+ ε ⟶
         (let (xd, xε) = sp d ε x
           in g x = (xd, eε xε) ∧
              ((jn d ε o fd ⊗f (iε o f o eε) o sp d ε) x = f' x) ∧
              DεE xε ∧ DεI (f (eε xε)) ∧
              Djn d ε (fd xd, iε (f (eε xε))) ∧ Dsp d ε x))›




paragraph ‹Convention›

φreasoner_group separatable_unzip__all = (1000, [1, 3000]) for ‹separatable_unzip z uz Du m m1 m2 f g›
      ‹If and how could a pairwise separated mapping ‹f ⊕f g› that is applied on an unzipped structure
       ‹F(T∗U)› over some pair data ‹T∗U›, be represneted as element-wise mapping over the original structure.›
  and separatable_unzip = (1000, [1000,1030]) in separatable_unzip__all ‹default group›

  and separatable_zip__all = (1000, [1,3000]) for ‹separatable_zip uz z Dz m m1 m2 f g›
      ‹If and how could an element-wise mapping ‹m (f ⊕f g)› of pairwisely separated element mapping ‹f ⊕f g›
       that is applied on the zip of two structure ‹F(T)› and ‹F(U)›, be separated to two mappings
       ‹m1› and ‹m2› over ‹F(T)› and ‹F(U)› respectively›
  and separatable_zip = (1000, [1000,1030]) in separatable_zip__all ‹default group›
  and separatable_zip__norm = (2000, [2000,2100]) in separatable_zip__all
      ‹normalization›

  and compositional_mapper__all = (1000, [1, 3000]) for ‹compositional_mapper m1 m2 m3 D f g› ‹›
  and compositional_mapper = (1000, [1000,1030]) in compositional_mapper__all ‹›

  and domain_of_inner_map__all = (1000, [1, 3000]) for ‹domain_of_inner_map mapper Di› ‹›
  and domain_of_inner_map = (1000, [1000,1030]) in domain_of_inner_map__all ‹›

  and separatable_module_zip__all = (1000, [1, 3000])
      for (‹separatable_module_zip flag d a b c uz' z' uz z D f g f' g'›)
      ‹separatable zip and unzip operations of a module φ-type›
  and separatable_module_zip = (1000, [1000,1030]) in separatable_module_zip__all
      ‹the default group›

  and module_mapper__all = (1000, [1, 3000])
      for (‹module_mapper3εC Cc Cd c ε dε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g›,
           ‹module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g›,
           ‹module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g›,
           ‹module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g›,
           ‹module_mapper13C Cc Cd d a da c sp jn Dsp Djn D fd fa fc f g›,
           ‹module_mapper12L d a sp jn Dsp Djn D fd fa f›,
           ‹module_mapper31C Cc Cd c b db d sp jn Dsp Djn D fc f fd f' g›,
           ‹module_mapper21L b d sp jn Dsp Djn D f fd f'›)
      ‹transformation mappers of module φ-types›
  and module_mapper = (1000, [1000, 1030]) in module_mapper__all
      ‹the default group›
  and module_mapper_default = (10,[10,30]) in module_mapper__all
      ‹default rules›
  and module_mapper_syserr = (0,[0,0]) < module_mapper__all
      ‹sys error›

declare [[
  φreason_default_pattern
      ‹domain_by_mapper ?D' ?m ?D ?var_f _› ⇒ ‹domain_by_mapper ?D' ?m ?D _ _› (100)
  and ‹separatable_unzip ?z ?uz _ ?m _ _ ?var_f ?var_g› ⇒
      ‹separatable_unzip ?z ?uz _ ?m _ _ _ _›                       (100)
  and ‹separatable_cond_unzip ?C ?z ?uz _ ?m _ _ ?var_f ?var_g› ⇒
      ‹separatable_cond_unzip ?C ?z ?uz _ ?m _ _ _ _›               (100)
  and ‹separatable_zip ?uz ?z _ ?m _ _ ?var_f ?var_g› ⇒
      ‹separatable_zip ?uz ?z _ ?m _ _ _ _›                         (100)
  and ‹separatable_cond_zip ?C ?uz ?z _ ?m _ _ ?var_f ?var_g› ⇒
      ‹separatable_cond_zip ?C ?uz ?z _ ?m _ _ _ _›                  (100)
  and ‹compositional_mapper ?m1 ?m2 _ _ ?var_f ?var_g› ⇒
      ‹compositional_mapper ?m1 _ _ _ _ _›
      ‹compositional_mapper _ ?m2 _ _ _ _›                           (100)
  and ‹domain_of_inner_map ?m _› ⇒ ‹domain_of_inner_map ?m _›                                  (100)
  and ‹separatable_module_zip ?flag ?var_d ?var_a ?var_b ?var_c ?uz' ?z' ?uz ?z _ _ _ _ _› ⇒
      ‹separatable_module_zip ?flag _ _ _ _  ?uz' ?z' ?uz ?z _ _ _ _ _›                      (100)

  and ‹module_mapper3εC ?Cc ?Cd ?c ?ε ?dε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _› ⇒
      ‹module_mapper3εC ?Cc ?Cd ?c ?ε ?dε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _›    (100)
  and ‹module_mapper3ε ?c ?ε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _› ⇒
      ‹module_mapper3ε ?c ?ε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _›              (100)
  and ‹module_mapper2εR ?c ?ε ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _› ⇒
      ‹module_mapper2εR ?c ?ε ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _›                   (100)
  and ‹module_mapper2εL ?ε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _› ⇒
      ‹module_mapper2εL ?ε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _›                   (100)

  and ‹module_mapper13C ?Cc ?Cd ?d ?a ?da ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _› ⇒
      ‹module_mapper13C ?Cc ?Cd ?d ?a ?da ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _›                   (100)
  and ‹module_mapper13 ?d ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _› ⇒
      ‹module_mapper13 ?d ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _›                               (100)
  and ‹module_mapper12L ?d ?a ?sp ?jn ?Dsp ?Djn _ _ _ _› ⇒
      ‹module_mapper12L ?d ?a ?sp ?jn ?Dsp ?Djn _ _ _ _›                                      (100)
  and ‹module_mapper12R ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _› ⇒
      ‹module_mapper12R ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _›                                      (100)

  and ‹module_mapper31C ?Cc ?Cd ?c ?b ?db ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _› ⇒
      ‹module_mapper31C ?Cc ?Cd ?c ?b ?db ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _›                    (100)
  and ‹module_mapper31 ?c ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _› ⇒
      ‹module_mapper31 ?c ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _›                                (100)
  and ‹module_mapper21R ?b ?c ?sp ?jn ?Dsp ?Djn _ _ _ _› ⇒
      ‹module_mapper21R ?b ?c ?sp ?jn ?Dsp ?Djn _ _ _ _›                                      (100)
  and ‹module_mapper21L ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _› ⇒
      ‹module_mapper21L ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _›                                      (100)


  and ‹domain_by_mapper ?D' ?m ?D ?f ?Ddm› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (domain_by_mapper ?D' ?m ?D ?f ?Ddm))›            (0)
  and ‹separatable_unzip ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (separatable_unzip ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g))› (0)
  and ‹separatable_zip ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (separatable_zip ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g))›  (0)
  and ‹separatable_cond_unzip ?C ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (separatable_cond_unzip ?C ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g))› (0)
  and ‹separatable_cond_zip ?C ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (separatable_cond_zip ?C ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g))›  (0)
  and ‹compositional_mapper ?m1 ?m2 ?m3 ?D ?f ?g› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (compositional_mapper ?m1 ?m2 ?m3 ?D ?f ?g))›    (0)
  and ‹domain_of_inner_map ?m ?Di› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (domain_of_inner_map ?m ?Di))›                   (0)
  and ‹separatable_module_zip ?flag ?d ?a ?b ?c ?uz' ?z' ?uz ?z ?D ?f ?g ?f' ?g'› ⇒
      ‹ERROR TEXT(‹Malformed Rule› (separatable_module_zip ?flag ?d ?a ?b ?c ?uz' ?z' ?uz ?z ?D ?f ?g ?f' ?g'))›  (0)
,
  φdefault_reasoner_group
      ‹separatable_unzip _ _ _ _ _ _ _ _› : %separatable_unzip  (100)
  and ‹separatable_zip _ _ _ _ _ _ _ _›   : %separatable_zip    (100)
  and ‹separatable_cond_unzip _ _ _ _ _ _ _ _ _› : %separatable_unzip  (100)
  and ‹separatable_cond_zip _ _ _ _ _ _ _ _ _›   : %separatable_zip    (100)
  and ‹compositional_mapper _ _ _ _ _ _›: %compositional_mapper (100)
  and ‹domain_of_inner_map _ _›         : %domain_of_inner_map  (100)
  and ‹separatable_module_zip _ _ _ _ _  _ _ _ _ _ _ _ _ _›  : %separatable_module_zip (100)
  and ‹module_mapper3εC _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _› : %module_mapper (100)
  and ‹module_mapper3ε _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _›        : %module_mapper (100)
  and ‹module_mapper2εR _ _ _ _ _ _ _ _ _ _ _ _ _ _ _›           : %module_mapper (100)
  and ‹module_mapper2εL _ _ _ _ _ _ _ _ _ _ _ _ _ _ _›           : %module_mapper (100)
]]

paragraph ‹Basic Rules›

subparagraph ‹Module Error›

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹, joiner› jn
               ‹, identity constructor› iε ‹and destructor› eε ‹, you may provide a LPR reasoning rule›
               (module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g) ‹to address the issue.›)
⟹ module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹, joiner› jn
               ‹, identity constructor› iε ‹and destructor› eε ‹, you may provide a LPR reasoning rule›
               (module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g) ‹to address the issue.›)
⟹ module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹, joiner› jn
               ‹, identity constructor› iε ‹and destructor› eε ‹, you may provide a LPR reasoning rule›
               (module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g) ‹to address the issue.›)
⟹ module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g) ‹to address the issue.›)
⟹ module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper12L d a sp jn Dsp Djn D fd fa f) ‹to address the issue.›)
⟹ module_mapper12L d a sp jn Dsp Djn D fd fa f ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper12R a c sp jn Dsp Djn D fa fc f) ‹to address the issue.›)
⟹ module_mapper12R a c sp jn Dsp Djn D fa fc f ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g) ‹to address the issue.›)
⟹ module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper21L b d sp jn Dsp Djn D f fd f') ‹to address the issue.›)
⟹ module_mapper21L b d sp jn Dsp Djn D f fd f' ›
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ‹ ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper21R b c sp jn Dsp Djn D fc f f') ‹to address the issue.›)
⟹ module_mapper21R b c sp jn Dsp Djn D fc f f' ›
  unfolding ERROR_def
  by blast


subparagraph ‹Module Conversions›

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g
⟹ module_mapper3εC True True c ε dε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g ›
  unfolding module_mapper3εC_def module_mapper3ε_def
  by simp

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g
⟹ module_mapper3εC True False c ε dε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f'
                    (λx. case g x of (ε,c) ⇒ (unspec,ε,c)) ›
  unfolding module_mapper3εC_def module_mapper2εR_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g
⟹ module_mapper3εC False True c ε dε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f'
                    (λx. case g x of (d,ε) ⇒ (d,ε,unspec)) ›
  unfolding module_mapper3εC_def module_mapper2εL_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ε = dε
⟹ module_mapper1ε ε eε iε DεE DεI D f f'
⟹ module_mapper3εC False False c ε dε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f'
                    (λx. (unspec, eε x, unspec)) ›
  unfolding module_mapper3εC_def module_mapper1ε_def 𝗋Guard_def Premise_def
  by simp

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g
⟹ module_mapper13C True True d a da c sp jn Dsp Djn D fd fa fc f g ›
  unfolding module_mapper13C_def module_mapper13_def
  by clarsimp

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper12L d a sp jn Dsp Djn D fd fa f
⟹ module_mapper13C False True d a da c sp jn Dsp Djn
                    (λ(xa,xd,xc). D (xd,xa)) fd fa (λ_. unspec) f (λ(xa,xd,xc). jn d a (xd,xa)) ›
  unfolding module_mapper13C_def module_mapper12L_def Let_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper12R a c sp jn Dsp Djn D fa fc f
⟹ module_mapper13C True False d a da c sp jn Dsp Djn
                    (λ(xa,xd,xc). D (xa,xc)) (λ_. unspec) fa fc f (λ(xa,xd,xc). jn a c (xa,xc)) ›
  unfolding module_mapper13C_def module_mapper12R_def Let_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g
⟹ module_mapper31C True True c b db d sp jn Dsp Djn D fc f fd f' g ›
  unfolding module_mapper31_def module_mapper31C_def
  by clarsimp

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper21L b d sp jn Dsp Djn D f fd f'
⟹ module_mapper31C False True c b db d sp jn Dsp Djn D fc f fd f'
                    (λx. case sp d b x of (xd,xb) ⇒ (xd, xb, unspec)) ›
  unfolding module_mapper21L_def module_mapper31C_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  ‹ module_mapper21R b c sp jn Dsp Djn D fc f f'
⟹ module_mapper31C True False c b db d sp jn Dsp Djn D fc f fd f'
                    (λx. case sp b c x of (xb, xc) ⇒ (unspec, xb, xc))›
  unfolding module_mapper31C_def module_mapper21R_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  ‹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 b = db
⟹ module_mapper31C False False c b db d sp jn Dsp Djn (λ_. True) fc f fd f
                    (λx. (unspec, x, unspec))›
  unfolding module_mapper31C_def module_mapper21R_def
  by clarsimp


paragraph ‹Instances›

subparagraph ‹Identity Mappers›

lemma [φreason add]:
  ‹ separatable_unzip (λx. x) (λx. x) UNIV (λf. f) (λf. f) (λf. f) g r ›
  unfolding separatable_unzip_def
  by simp

lemma [φreason add]:
  ‹ separatable_zip (λx. x) (λx. x) UNIV (λf. f) (λf. f) (λf. f) f g ›
  unfolding separatable_zip_def
  by simp

lemma [φreason add]:
  ‹ compositional_mapper (λf. f) (λf. f) (λf. f) UNIV f g ›
  unfolding compositional_mapper_def
  by simp

lemma [φreason add]:
  ‹ domain_of_inner_map (λf. f) (λx. {x}) ›
  unfolding domain_of_inner_map_def
  by simp

lemma [φreason add]:
  ‹domain_by_mapper (λx. {x}) (λf. f) (λx. {x}) f UNIV›
  unfolding domain_by_mapper_def
  by clarsimp


subparagraph ‹Conditioned›

lemma [φreason %separatable_zip__norm]:
  ‹ separatable_cond_unzip (LPR_ctrl C) (?Z (LPR_ctrl C) z mZ) (?UZ (LPR_ctrl C) uz mU) DU' m mf mg f g
⟹ separatable_cond_unzip C (?Z (LPR_ctrl C) z mZ) (?UZ (LPR_ctrl C) uz mU) DU' m mf mg f g ›
  unfolding LPR_ctrl_def .

lemma [φreason %separatable_zip__norm]:
  ‹ separatable_cond_zip (LPR_ctrl C) (?UZ (LPR_ctrl C) uz mU) (?Z (LPR_ctrl C) z mZ) DU' m mf mg f g
⟹ separatable_cond_zip C (?UZ (LPR_ctrl C) uz mU) (?Z (LPR_ctrl C) z mZ) DU' m mf mg f g ›
  unfolding LPR_ctrl_def .

lemma [φreason add]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 separatable_unzip z uz DU m mf mg f g ∧𝗋
          compositional_mapper mf mU m2 Dm f fst ∧𝗋
          compositional_mapper mZ m2 m Dm2 (λx. (x, unspec)) (f o fst)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DU' : {x. if C then x ∈ DU else x ∈ Dm ∩ Dm2}
⟹ separatable_cond_unzip C (?Z C z mZ) (?UZ C uz mU) DU' m mf (?M C mg) f g ›
  unfolding 𝗋Guard_def compositional_mapper_def Ant_Seq_def
            separatable_unzip_def separatable_cond_unzip_def Simplify_def
  by (cases C; clarsimp; metis prod.map_beta)

lemma [φreason add]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 separatable_zip uz z DU m mf mg f g ∧𝗋
          compositional_mapper m mZ m2 Dm (f ⊗f (λ_. unspec)) (λx. (x, unspec)) ∧𝗋
          compositional_mapper mU m2 mf Dm2 fst (λx. (f x, unspec))
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DU' : {x. if C then x ∈ DU else fst x ∈ Dm ∩ Dm2}
⟹ separatable_cond_zip C (?UZ C uz mU) (?Z C z mZ) DU' m mf (?M C mg) f g ›
  unfolding 𝗋Guard_def compositional_mapper_def Ant_Seq_def
            separatable_zip_def separatable_cond_zip_def Simplify_def
  by (cases C; clarsimp)


subparagraph ‹List›

lemma [φreason for ‹
          module_mapper1ε ?ε hd (λx. [x]) (λl. length l = _) (λ_. True) _ _ _ ›]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1 
⟹ module_mapper1ε one' hd (λx. [x]) (λl. length l = one) (λ_. True) (λl. length l = 1) f (map f) ›
  unfolding module_mapper1ε_def 𝗋Guard_def Premise_def
  by (simp, metis Suc_length_conv length_0_conv length_map list.map_sel(1) list.sel(1))


lemma [φreason for
          ‹module_mapper2εR ?c ⟦?j : _⦆
           (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
           (λs t (x, y). x @ y) hd (λx. [x])
           (λl. length l = _) (λ_. True)
           (λs t x. length x = len_intvl.len s + len_intvl.len t)
           (λs t (x,y). length x = len_intvl.len s ∧ length y = len_intvl.len t) _ _ _ _ _ ›]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1 ∧ one' = 1
⟹ module_mapper2εR c ⟦j : one⦆
        (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
        (λs t (x, y). x @ y) hd
        (λx. [x]) (λl. length l = one') (λ_. True)
        (λs t x. length x = len_intvl.len s + len_intvl.len t)
        (λs t (x, y). length x = len_intvl.len s ∧ length y = len_intvl.len t)
        (λx. length x = 1 + len_intvl.len c ∧ length_preserving_map {drop 1 x} fc)
        fc f
        ( list_upd_map 0 f o sublist_map_R 1 fc )
        (λl. (hd l, drop 1 l)) ›
  unfolding module_mapper2εR_def sublist_map_L_def list_upd_map_def sublist_map_R_def
            length_preserving_map_def 𝗋Guard_def Premise_def
  by (auto simp add: hd_drop_conv_nth nth_append upd_conv_take_nth_drop hd_conv_nth)

lemma [φreason for
          ‹module_mapper2εL ⟦?j : _⦆ ?d
           (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
           (λs t (x,y). x @ y) hd (λx. [x])
           (λl. length l = _) (λ_. True)
           (λs t x. length x = len_intvl.len s + len_intvl.len t)
           (λs t (x,y). length x = len_intvl.len s ∧ length y = len_intvl.len t) _ _ _ _ _ ›]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1 ∧ one' = 1
⟹ module_mapper2εL ⟦j : one⦆ d
    (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
    (λs t (x,y). x @ y) hd
    (λx. [x]) (λl. length l = one') (λ_. True)
    (λs t x. length x = len_intvl.len s + len_intvl.len t)
    (λs t (x,y). length x = len_intvl.len s ∧ length y = len_intvl.len t)
    (λx. length x = len_intvl.len d + 1 ∧ length_preserving_map {take (len_intvl.len d) x} fd)
    f fd
    ( sublist_map_L (len_intvl.len d) fd o list_upd_map (len_intvl.len d) f )
    (λl. (take (len_intvl.len d) l, l ! (len_intvl.len d))) ›
  unfolding module_mapper2εL_def sublist_map_L_def list_upd_map_def sublist_map_R_def
            length_preserving_map_def Premise_def 𝗋Guard_def
  by (auto simp add: hd_drop_conv_nth nth_append upd_conv_take_nth_drop)

lemma [φreason for
          ‹module_mapper3ε ?c ⟦?j : _⦆ ?d
           (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
           (λs t (x,y). x @ y) hd (λx. [x])
           (λl. length l = _) (λ_. True)
           (λs t x. length x = len_intvl.len s + len_intvl.len t)
           (λs t (x,y). length x = len_intvl.len s ∧ length y = len_intvl.len t) _ _ _ _ _ _›]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1 ∧ one' = 1
⟹ module_mapper3ε c ⟦j : one⦆ d
     (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
     (λs t (x,y). x @ y) hd
     (λx. [x]) (λl. length l = one') (λ_. True)
     (λs t x. length x = len_intvl.len s + len_intvl.len t)
     (λs t (x,y). length x = len_intvl.len s ∧ length y = len_intvl.len t)
     (λx. length x = len_intvl.len d + 1 + len_intvl.len c ∧
          length_preserving_map {drop (len_intvl.len d + 1) x} fc ∧
          length_preserving_map {take (len_intvl.len d) x} fd)
     fc f fd
     ( sublist_map_L (len_intvl.len d) fd
     o list_upd_map (len_intvl.len d) f
     o sublist_map_R (len_intvl.len d+1) fc )
     (λl. (take (len_intvl.len d) l, l ! (len_intvl.len d), drop (len_intvl.len d + 1) l))›
  unfolding module_mapper3ε_def sublist_map_L_def list_upd_map_def sublist_map_R_def
            length_preserving_map_def Premise_def 𝗋Guard_def
  by (auto simp add: hd_drop_conv_nth nth_append upd_conv_take_nth_drop)




subsection ‹Definitions›

subsubsection ‹Transformations›

paragraph ‹Variant Functor›

definition ‹Transformation_Functor F1 F2 T U D R mapper ⟷
  (∀x g. (∀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b) ⟶
             (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x) ⟶
             (x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y))›
  ― ‹f1 and d1 make the domain set.

  The definition is given in reasoning-friendly form and should entail, (TODO: verify!)

  definition ‹Transformation_Functor F1 F2 mapper ⟷
    (∀T U r x. (∀x. x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. (x,y) ∈ r) ⟶
               (x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. (x,y) ∈ mapper r))›,
  when D is UNIV

  The nondeterminancy from relation ‹r› can be achieved by embedding ExTyp.

  We strengthen this original definition by allowing the domain of the element transformation to be
  depended on the source object of the functor transformation so that the reasoning can have more
  information about the domain of the element transformation.


  ‹R› constrains the range of the transformation of the inner elements, which will be a proof obligation
      reported to users for each transformation application.
  It is useful especially for dependent data types like a list of even numbers.
  As ‹R› is parameterized by the abstract container ‹x›, by assigning ‹R› to empty set on certain
  invalid abstract containers, it also constraints the domain of abstract containers on which
  the transformation functor is available.

  For general data structures which do not assumes such, tt is usually ‹λ_. ⊤›.
  Our automatic deriver by default assumes it to ‹λ_. ⊤› if no user hint is given.
›

text ‹A transformation functor ‹mapper› is complete iff for a given complete transformation relation
family ‹{gi}›, ‹{mapper gi}› is also complete (the notion of completeness can be extended to relations naturally
by converting a relation as a function to a set).›

(*It seems we have the need to give bifunctor*)

definition Functional_Transformation_Functor :: ‹(('b,'a) φ ⇒ ('d,'c) φ)
                                               ⇒ (('b,'e) φ ⇒ ('d,'f) φ)
                                               ⇒ ('b,'a) φ
                                               ⇒ ('b,'e) φ
                                               ⇒ ('c ⇒ 'a set)
                                               ⇒ ('c ⇒ 'e set)
                                               ⇒ (('a ⇒ 'e) ⇒ ('a ⇒ bool) ⇒ 'c ⇒ bool)
                                               ⇒ (('a ⇒ 'e) ⇒ ('a ⇒ bool) ⇒ 'c ⇒ 'f)
                                               ⇒ bool›
  where ‹Functional_Transformation_Functor Fa Fb T U D R pred_mapper func_mapper ⟷
            (∀x f P. (∀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a ⦂ U 𝗐𝗂𝗍𝗁 P a)
                ⟶ (∀a. a ∈ D x ⟶ f a ∈ R x)
                ⟶ (x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x ⦂ Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x))›

text ‹When the element transformation is applied with a partial function (with ‹P› giving the domain),
  the entire transformation is also a partial function.
  The ▩‹func_mapper› is usually the functional mapper and the
  ▩‹pred_mapper› is the predicate mapper of an ADT. An exceptional example is set,
  ‹func_mapperset f P S = { f x |x ∈ S. P x }› and ‹pred_mapperset f P S = ⊤›,
  whose (generalized) algebraic mappers are however set image and set-forall (of its element).

  ‹P› gives the domain of the partial map ‹f›.
  ‹D› gives the domain of the inner elements of the functor.
›


lemma infer_FTF_from_FT:
  ‹ Transformation_Functor F1 F2 T U D R mapper
⟹ Object_Equiv (F2 U) eq
⟹ (∀f P x y. mapper (λa b. b = f a ∧ P a) x y ⟶ eq y (fm f P x) ∧ pm f P x)
⟹ Functional_Transformation_Functor F1 F2 T U D R pm fm ›
  unfolding Functional_Transformation_Functor_def Transformation_Functor_def
            Object_Equiv_def
  apply clarsimp
  subgoal premises prems for x f P
    by (insert prems(1)[THEN spec[where x=x], THEN spec[where x=‹λa b. b = f a ∧ P a›]]
               prems(2-),
        clarsimp simp add: Transformation_def,
        blast) .


paragraph ‹Variant Bi-Functor›

definition ‹Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper ⟷
  (∀x g1 g2. (∀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b) ⟶
            (∀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b) ⟶
            (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x) ⟶
            (x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y))›

definition ‹Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pred_mapper func_mapper ⟷
    (∀x f1 f2 P1 P2. (∀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ U1 𝗐𝗂𝗍𝗁 P1 a)
                ⟶ (∀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 𝗐𝗂𝗍𝗁 P2 a)
                ⟶ (∀a. a ∈ D1 x ⟶ f1 a ∈ R1 x) ∧ (∀a. a ∈ D2 x ⟶ f2 a ∈ R2 x)
                ⟶ (x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x ⦂ Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x))›

lemma infer_biFTF_from_biFT:
  ‹ Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ Object_Equiv (Fb U1 U2) eq
⟹ (∀f1 f2 P1 P2 x y. mapper (λa b. b = f1 a ∧ P1 a) (λa b. b = f2 a ∧ P2 a) x y
                  ⟶ eq y (fm f1 f2 P1 P2 x) ∧ pm f1 f2 P1 P2 x)
⟹ Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pm fm ›
  unfolding Functional_Transformation_BiFunctor_def Transformation_BiFunctor_def
            Object_Equiv_def
  apply clarify
  subgoal premises prems for x f1 f2 P1 P2
    by (insert prems(1)[THEN spec[where x=x],
                        THEN spec[where x=‹λa b. b = f1 a ∧ P1 a›],
                        THEN spec[where x=‹λa b. b = f2 a ∧ P2 a›]]
               prems(2-),
        clarsimp simp add: Transformation_def,
        blast) .


paragraph ‹Variant Functor with Parameterization›

definition ‹Transformation_FunctorΛ F1 F2 T U D R mapper ⟷
  (∀x g. (∀p. ∀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b) ⟶
             (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x) ⟶
             (x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y))›

definition ‹Functional_Transformation_FunctorΛ Fa Fb T U D R pred_mapper func_mapper ⟷
            (∀x f P. (∀p. ∀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a ⦂ U p 𝗐𝗂𝗍𝗁 P p a)
                ⟶ (∀p a. a ∈ D p x ⟶ f p a ∈ R p x)
                ⟶ (x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x ⦂ Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x))›

lemma infer_FTFΛ_from_FTΛ:
  ‹ Transformation_FunctorΛ F1 F2 T U D R mapper
⟹ Abstract_Domain (F1 T) PT
⟹ Abstract_Domain (F2 U) PU
⟹ Object_Equiv (F2 U) eq
⟹ (∀f P x y. PT x ∧ PU y ∧ mapper (λp a b. b = f p a ∧ P p a) x y ⟶ eq y (fm f P x) ∧ pm f P x)
⟹ Functional_Transformation_FunctorΛ F1 F2 T U D R pm fm ›
  unfolding Functional_Transformation_FunctorΛ_def Transformation_FunctorΛ_def
            Object_Equiv_def Abstract_Domain_def Action_Tag_def Satisfiable_def 𝗋EIF_def
  apply clarsimp
  subgoal premises prems for x f P
    by (insert prems(1)[THEN spec[where x=x], THEN spec[where x=‹λp a b. b = f p a ∧ P p a›]]
               prems(2-),
        clarsimp simp add: Transformation_def,
        blast) .


paragraph ‹(Contravariant, Variant) Bi-Functor›

definition ‹CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper ⟷
  (∀x g1 g2. (∀a. (a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 b a)) ⟶
            (∀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b) ⟶
            (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x) ⟶
            (x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y))›

definition ‹Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pred_mapper func_mapper ⟷
    (∀x f1 f2 P1 P2. (∀a. f1 a ∈ D1 x ⟶ (a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ T1 𝗐𝗂𝗍𝗁 P1 a))
                ⟶ (∀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 𝗐𝗂𝗍𝗁 P2 a)
                ⟶ FC1 f1 x ∧ (∀a. a ∈ D2 x ⟶ f2 a ∈ R2 x)
                ⟶ (x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x ⦂ Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x))›






subsubsection ‹Separation›

definition Object_Sep_HomoI :: ‹('b::sep_magma, 'a::sep_magma) φ ⇒ ('a × 'a) set ⇒ bool›
  where ‹Object_Sep_HomoI T D ⟷ (∀x y. (x,y) ∈ D ⟶ ((x ⦂ T) * (y ⦂ T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x * y ⦂ T 𝗐𝗂𝗍𝗁 x ## y ))›

definition ‹Object_Sep_HomoE T ⟷ (∀x y. x ## y ⟶ ( (x * y ⦂ T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x ⦂ T) * (y ⦂ T) ))›

definition Separation_HomoI :: ‹
                (('b::sep_magma_1,'a) φ ⇒ ('d::sep_magma_1,'c) φ)
             ⇒ (('b,'e) φ ⇒ ('d,'f) φ)
             ⇒ (('b, 'a × 'e) φ ⇒ ('d,'g) φ)
             ⇒ ('b,'a) φ ⇒ ('b,'e) φ
             ⇒ ('c × 'f) set ⇒ ('c × 'f ⇒ 'g) ⇒ bool›
    where ‹Separation_HomoI Ft Fu F3 T U D z ⟷
              (∀x y. (x,y) ∈ D ⟶ ((x,y) ⦂ Ft(T) ∗ Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y) ⦂ F3 (T ∗ U)))›

definition ‹Separation_HomoI2 Ft Fu F3 T1 T2 U1 U2 D z ⟷
              (∀x y. (x,y) ∈ D ⟶ ((x,y) ⦂ Ft T1 T2 ∗ Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y) ⦂ F3 (T1 ∗ U1) (T2 ∗ U2) ))›

definition Separation_HomoE :: ‹
                 (('b::sep_magma,'a) φ ⇒ ('d::sep_magma_1,'c) φ)
              ⇒ (('b,'e) φ ⇒ ('d,'f) φ)
              ⇒ (('b, 'a × 'e) φ ⇒ ('d,'g) φ)
              ⇒ ('b,'a) φ ⇒ ('b,'e) φ ⇒ 'g set ⇒ ('g ⇒ 'c × 'f) ⇒ bool›
    where ‹Separation_HomoE Ft Fu F3 T U Du un ⟷ ― ‹Does it need a domain constraint?›
              (∀z∈Du. z ⦂ F3 (T ∗ U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z ⦂ Ft T ∗ Fu U)›

definition ‹Separation_HomoE2 Ft Fu F3 T1 T2 U1 U2 Du un ⟷
              (∀z∈Du. z ⦂ F3 (T1 ∗ U1) (T2 ∗ U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z ⦂ Ft T1 T2 ∗ Fu U1 U2) ›


definition Separation_HomoI_Cond :: ‹
            (('b::sep_magma_1,'a) φ ⇒ ('d::sep_magma_1,'c) φ)
         ⇒ (('b,'e) φ ⇒ ('d,'f) φ)
         ⇒ (('b, 'a × 'e) φ ⇒ ('d,'g) φ)
         ⇒ bool ⇒ ('b,'a) φ ⇒ ('b,'e) φ
         ⇒ ('c × 'f) set ⇒ ('c × 'f ⇒ 'g)
         ⇒ bool›
    where ‹Separation_HomoI_Cond Ft Fu F3 CW T U D z ⟷
              (∀x y. (x,y) ∈ D ⟶ ((x,y) ⦂ Ft T ∗ ◒[CW] Fu U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y) ⦂ F3 (T ∗ ◒[CW] U)))›

definition ‹Separation_HomoI2_Cond Ft Fu F3 CW T1 T2 U1 U2 D z ⟷
              (∀x y. (x,y) ∈ D ⟶ ((x,y) ⦂ Ft T1 T2 ∗ ◒[CW] Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y) ⦂ F3 (T1 ∗ ◒[CW] U1) (T2 ∗ ◒[CW] U2) ))›


definition Separation_HomoE_Cond :: ‹
            (('b::sep_magma_1,'a) φ ⇒ ('d::sep_magma_1,'c) φ)
         ⇒ (('b,'e) φ ⇒ ('d,'f) φ)
         ⇒ (('b, 'a × 'e) φ ⇒ ('d,'g) φ)
         ⇒ bool ⇒ ('b,'a) φ ⇒ ('b,'e) φ
         ⇒ 'g set ⇒ ('g ⇒ 'c × 'f) ⇒ bool›
    where ‹Separation_HomoE_Cond Ft Fu F3 CR T U D un ⟷
              (∀z. z ∈ D ⟶ (z ⦂ F3 (T ∗ ◒[CR] U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z ⦂ Ft T ∗ ◒[CR] Fu U))›

definition ‹Separation_HomoE2_Cond Ft Fu F3 C T1 T2 U1 U2 D un ⟷
             (∀z. z ∈ D ⟶ (z ⦂ F3 (T1 ∗ ◒[C] U1) (T2 ∗ ◒[C] U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z ⦂ Ft T1 T2 ∗ ◒[C] Fu U1 U2 ))›



paragraph ‹With Parameter›

definition ‹Separation_HomoΛI Ft Fu F3 T U D z ⟷
              (∀x y. (x,y) ∈ D ⟶ ((x,y) ⦂ Ft(T) ∗ Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y) ⦂ F3 (λp. T p ∗ U p)))›

definition ‹Separation_HomoΛE Ft Fu F3 T U Du un ⟷
              (∀z∈Du. z ⦂ F3 (λp. T p ∗ U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z ⦂ Ft T ∗ Fu U)›

definition ‹Separation_HomoΛI_Cond Ft Fu F3 C T U D z ⟷
              (∀x y. (x,y) ∈ D ⟶ ((x,y) ⦂ Ft(T) ∗ ◒[C] Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y) ⦂ F3 (λp. T p ∗ ◒[C] U p)))›

definition ‹Separation_HomoΛE_Cond Ft Fu F3 C T U D un ⟷
              (∀z. z ∈ D ⟶ (z ⦂ F3 (λp. T p ∗ ◒[C] U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z ⦂ Ft T ∗ ◒[C] Fu U))›


subsubsection ‹Semimodule›

text ‹Convention: the domain ‹Dx› of object gives proof obligation but the domain ‹Ds› of scalar is
  a reasoning guard. Recall the reasoning is guided by types, the reasoning should be determined
  only by types, where a proof obligation about the objects are yielded as an outcome.
  ‹Dx› is totally about objects but ‹Ds› is about scalar and scalar is in type-level.
›

definition Module_Zero :: ‹('s ⇒ ('c::one,'a) φ) ⇒ 's ⇒ bool›
  where ‹Module_Zero F zero ⟷ (∀x. (x ⦂ F zero) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1)›

definition Closed_Module_Zero :: ‹('s ⇒ ('c::one,'a) φ) ⇒ 's ⇒ bool›
  where ‹Closed_Module_Zero F zero ⟷ (∀x. (x ⦂ F zero) = 1)›
  ― ‹It is actually a very strong property particularly when ‹T› is an empty φ-type of empty
      abstract domain. It excludes functional homomorphism like ‹F c T ≡ ψ c ⨾f T›.›

definition Module_OneI :: ‹('s ⇒ ('c,'a) φ)
                            ⇒ ('c,'a1) φ
                            ⇒ 's ⇒ ('a1 ⇒ bool) ⇒ ('a1 ⇒ 'a) ⇒ ('a1 ⇒ bool)
                            ⇒ bool›
  where ‹Module_OneI F T1 one D f P ⟷ (∀x. D x ⟶ (x ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F one 𝗐𝗂𝗍𝗁 P x))›
  ― ‹Domain information should be given in types. The unit scalar ‹one› belongs to domain info.
      So, the value of ‹one› should be able to be determined solely from ‹T1› and ‹F›, but no ‹x›.›

definition Module_OneE :: ‹('s ⇒ ('c,'a) φ)
                            ⇒ ('c,'a1) φ
                            ⇒ 's ⇒ ('a ⇒ bool) ⇒ ('a ⇒ 'a1) ⇒ ('a ⇒ bool)
                            ⇒ bool›
  where ‹Module_OneE F T1 one D f P ⟷ (∀x. D x ⟶ (x ⦂ F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ T1 𝗐𝗂𝗍𝗁 P x))›

(* no need, as covered by the rule of ‹individual → segment›
definition Semimodule_Cons :: ‹ ('s ⇒ ('cT,'aT) φ ⇒ ('c::sep_magma,'a) φ) ⇒ ('cT,'aT) φ ⇒ ('c,'a1) φ
                             ⇒ ('s ⇒ bool) ⇒ ('s ⇒ 'a1 ⇒ 'a ⇒ bool)
                             ⇒ ('a1 ⇒ 's ⇒ 's) ⇒ ('a1 ⇒ 'a ⇒ 'a)
                             ⇒ bool›
  where ‹Semimodule_Cons F T T1 Ds D incr cons ⟷
            (∀s a x. Ds s ∧ D s a x ⟶ ( (a,x) ⦂ T1 ∗ F s T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 cons a x ⦂ F (incr a s) T ))›
  ― ‹Given a φ-type ‹T1 ≠ F s' T'› not in a semimodule form, how to merge it into an existing semimodule.
      ‹Module_Zero› and ‹Semimodule_Cons› derives ‹Semimodule_Cons››
*)

(*
definition Module_Assoc :: ‹ ('s ⇒ ('c,'a) φ ⇒ ('c,'a) φ)
                                     ⇒ ('c,'a) φ
                                     ⇒ ('s::semigroup_mult ⇒ bool)
                                     ⇒ bool›
  where ‹Module_Assoc F T Ds ⟷ (∀s t. Ds s ∧ Ds t ⟶ F s (F t T) = F (t * s) T)›
  ― ‹Associativity of scalar multiplication›
*)

definition Module_AssocI :: ‹ ('ss ⇒ ('ct,'at) φ ⇒ ('cst,'as_t) φ)
                                     ⇒ ('st ⇒ ('c,'a) φ ⇒ ('ct,'at) φ)
                                     ⇒ ('sc ⇒ ('c,'a) φ ⇒ ('cst,'ast) φ)
                                     ⇒ ('c,'a) φ
                                     ⇒ ('ss ⇒ bool)
                                     ⇒ ('st ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'sc)
                                     ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ 'ast)
                                     ⇒ bool›
  where ‹Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
      ⟷ (∀s t x. Ds s ∧ Dt t ∧ Dx s t x ⟶ (x ⦂ Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fc (smul s t) T))›
  ― ‹An extension overcoming the type limitation of the simple type theory of Isabelle.
      It can cover mul quant›

definition Module_AssocE :: ‹ ('ss ⇒ ('ct,'at) φ ⇒ ('cst,'as_t) φ)
                                     ⇒ ('st ⇒ ('c,'a) φ ⇒ ('ct,'at) φ)
                                     ⇒ ('sc ⇒ ('c,'a) φ ⇒ ('cst,'ast) φ)
                                     ⇒ ('c,'a) φ
                                     ⇒ ('ss ⇒ bool)
                                     ⇒ ('st ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'ast ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'sc)
                                     ⇒ ('ss ⇒ 'st ⇒ 'ast ⇒ 'as_t)
                                     ⇒ bool›
  where ‹Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
      ⟷ (∀s t x. Ds s ∧ Dt t ∧ Dx s t x ⟶ (x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fs s (Ft t T)))›

text ‹The extended scalar association operator for Finite Multiplicative Quantification is just uncurrying.›

definition Module_AssocΛI :: ‹ ('ss ⇒ ('ps ⇒ ('ct,'at) φ) ⇒ ('cst,'as_t) φ)
                                     ⇒ ('st ⇒ ('pt ⇒ ('c,'a) φ) ⇒ ('ct,'at) φ)
                                     ⇒ ('sc ⇒ ('ps × 'pt ⇒ ('c,'a) φ) ⇒ ('cst,'ast) φ)
                                     ⇒ ('ps ⇒ 'pt ⇒ ('c,'a) φ)
                                     ⇒ ('ss ⇒ bool)
                                     ⇒ ('st ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'sc)
                                     ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ 'ast)
                                     ⇒ bool›
  where ‹Module_AssocΛI Fs Ft Fc T Ds Dt Dx smul f
      ⟷ (∀s t x. Ds s ∧ Dt t ∧ Dx s t x ⟶ (x ⦂ Fs s (λps. Ft t (T ps)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fc (smul s t) (case_prod T)))›

definition Module_AssocΛE :: ‹ ('ss ⇒ ('ps ⇒ ('ct,'at) φ) ⇒ ('cst,'as_t) φ)
                                     ⇒ ('st ⇒ ('pt ⇒ ('c,'a) φ) ⇒ ('ct,'at) φ)
                                     ⇒ ('sc ⇒ ('ps × 'pt ⇒ ('c,'a) φ) ⇒ ('cst,'ast) φ)
                                     ⇒ ('ps × 'pt ⇒ ('c,'a) φ)
                                     ⇒ ('ss ⇒ bool)
                                     ⇒ ('st ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ bool)
                                     ⇒ ('ss ⇒ 'st ⇒ 'sc)
                                     ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ 'ast)
                                     ⇒ bool›
  where ‹Module_AssocΛE Fs Ft Fc T Ds Dt Dx smul f
      ⟷ (∀s t x. Ds s ∧ Dt t ∧ Dx s t x ⟶ (f s t x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ Fs s (λps. Ft t (λpt. T (ps, pt)))))›


definition Module_Distr_HomoZ :: ‹ ('s ⇒ ('c::sep_magma,'a) φ)
                                    ⇒ ('s::partial_add_magma ⇒ bool)
                                    ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ bool)
                                    ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ 'a)
                                    ⇒ bool›
  where ‹Module_Distr_HomoZ F Ds Dx z ⟷
            (∀s t x. Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x ⟶ (x ⦂ F s ∗ F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ F (s + t) ))›
  ― ‹The left distributive law (i.e., the distributivity of scalar addition) of a left-module.
      Note the right distributive law (i.e., the distributivity of vector addition) is just the separation homomorphism.
      So, when both of ‹Module_Assoc›, ‹Separation_Homo›, ‹Module_Distr_HomoZ›, and
      homomorphism of identity element, are satisfied, it is then a semimodule.
›

definition Module_Distr_HomoZ_rev :: ‹('s ⇒ ('c::sep_magma,'a) φ)
                                        ⇒ ('s::partial_add_magma ⇒ bool)
                                        ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ bool)
                                        ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ 'a)
                                        ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ bool)
                                        ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ 'a)
                                        ⇒ bool›
  where ‹Module_Distr_HomoZ_rev F Ds Dx' z' Dx z ⟷
            (Module_Distr_HomoZ F Ds Dx' z' ⟶
            (∀s t x. Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x ⟶
                  (x ⦂ F s ∗ F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ F (t + s) )))›
  ― ‹Should be only used when assuming non-commutative separation algebra and non-commutative scalar,
      else should use ‹Module_Distr_HomoZ› instead, see ‹SDirst_in_comm_sep_implies_rev›
      and ‹SDirst_in_comm_scalar_implies_rev››
  ― ‹Note antecedents of ‹Module_Distr_HomoZ_rev› will not trigger the template instantiation, as
       they are not template parameters but normal reasoning goals.
      You may add a useless premise ‹Module_Distr_HomoZ› in your rule serving as a template parameter,
        as all instances of ‹Module_Distr_HomoZ_rev› are deduced from ‹Module_Distr_HomoZ›.
      It is not a template parameter because one ‹Module_Distr_HomoZ› may deduce multiple
        ‹Module_Distr_HomoZ_rev› depending on if the scalar or the separation algebra is commutative,
        and we really don't want multiple instantiations of a template parameter because the number
        of instantiations is multiplied!›


definition Module_Distr_HomoS :: ‹('s ⇒ ('c::sep_magma,'a) φ)
                                    ⇒ ('s::partial_add_magma ⇒ bool)
                                    ⇒ ('s ⇒ 's ⇒ 'a ⇒ bool)
                                    ⇒ ('s ⇒ 's ⇒ 'a ⇒ 'a × 'a)
                                    ⇒ bool›
  where ‹Module_Distr_HomoS F Ds Dx uz ⟷
            (∀s t x. Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x ⟶
                (x ⦂ F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s ∗ F t ))›

definition Module_Distr_HomoS_rev :: ‹('s ⇒ ('c::sep_magma,'a) φ)
                                        ⇒ ('s ⇒ 's ⇒ 'a ⇒ bool)
                                        ⇒ ('s ⇒ 's ⇒ 'a ⇒ 'a × 'a)
                                        ⇒ ('s::partial_add_magma ⇒ bool)
                                        ⇒ ('s ⇒ 's ⇒ 'a ⇒ bool)
                                        ⇒ ('s ⇒ 's ⇒ 'a ⇒ 'a × 'a)
                                        ⇒ bool›
  where ‹Module_Distr_HomoS_rev F Dx' uz' Ds Dx uz ⟷
            (Module_Distr_HomoS F Ds Dx' uz' ⟶
            (∀s t x. Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x ⟶
                (x ⦂ F (t + s) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s ∗ F t )))›
  ―‹Also not a template parameter, see ‹Module_Distr_HomoZ_rev››

definition Semimodule_No_SDistr :: ‹'a ⇒ bool›
  where ‹Semimodule_No_SDistr F ≡ True›
  ― ‹tagging the φ-type operator ‹F› has no scalar associativity, so hinting the use of the rules
      which are unsafe for scalar associativity.›


subsubsection ‹Commutativity between φ-Type Operators›

text ‹‹Separation_Homo› is a special case of the commutativity to ‹∗›.›

text ‹The properties are all given in relationform, while functional version can be obtained by
  and should be represented in term‹embedded_func› which prevents over-simplification
  (e.g., when ‹P = (λx. True)›)›

paragraph ‹Unary-to-Unary›

definition Tyops_Commute :: ‹ (('cG,'aG) φ ⇒ ('c,'a) φ)
                           ⇒ (('cT,'aT) φ ⇒ ('cF,'aF) φ)
                           ⇒ (('cT,'aT) φ ⇒ ('cG,'aG) φ)
                           ⇒ (('cF,'aF) φ ⇒ ('c,'b) φ)
                           ⇒ ('cT,'aT) φ
                           ⇒ ('a ⇒ bool)
                           ⇒ ('a ⇒ 'b ⇒ bool)
                           ⇒ bool›
  where ‹Tyops_Commute F F' G G' T D r ⟷
            (∀x. D x ⟶ (x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y))›


paragraph ‹Unary-to-Binary›

definition Tyops_Commute1_2 :: ‹ (('cG,'aG) φ ⇒ ('c,'a) φ)
                             ⇒ (('cT,'aT) φ ⇒ ('cFT,'aFT) φ)
                             ⇒ (('cU,'aU) φ ⇒ ('cFU,'aFU) φ)
                             ⇒ (('cT,'aT) φ ⇒ ('cU,'aU) φ ⇒ ('cG,'aG) φ)
                             ⇒ (('cFT,'aFT) φ ⇒ ('cFU,'aFU) φ ⇒ ('c,'b) φ)
                             ⇒ ('cT,'aT) φ
                             ⇒ ('cU,'aU) φ
                             ⇒ ('a ⇒ bool)
                             ⇒ ('a ⇒ 'b ⇒ bool)
                             ⇒ bool›
  where ‹Tyops_Commute1_2 F F'T F'U G G' T U D r ⟷
            (∀x. D x ⟶ (x ⦂ F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y))›

paragraph ‹Binary-to-Unary›

definition Tyops_Commute2_1 :: ‹ (('cG,'aG) φ ⇒ ('c,'a) φ)
                              ⇒ (('cT,'aT) φ ⇒ ('cFT,'aFT) φ)
                              ⇒ (('cU,'aU) φ ⇒ ('cFU,'aFU) φ)
                              ⇒ (('cT,'aT) φ ⇒ ('cU,'aU) φ ⇒ ('cG,'aG) φ)
                              ⇒ (('cFT,'aFT) φ ⇒ ('cFU,'aFU) φ ⇒ ('c,'b) φ)
                              ⇒ ('cT,'aT) φ
                              ⇒ ('cU,'aU) φ
                              ⇒ ('b ⇒ bool)
                              ⇒ ('b ⇒ 'a ⇒ bool)
                              ⇒ bool›
  where ‹Tyops_Commute2_1 F F'T F'U G G' T U D r ⟷
            (∀x. D x ⟶ (x ⦂ G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (G T U) 𝗌𝗎𝖻𝗃 y. r x y))›

paragraph ‹Over Parameterized Types›

definition Tyops_CommuteΛI :: ‹ (('cG,'aG) φ ⇒ ('c,'a) φ)
                             ⇒ (('cT,'aT) φ ⇒ ('cF,'aF) φ)
                             ⇒ (('p ⇒ ('cT,'aT) φ) ⇒ ('cG,'aG) φ)
                             ⇒ (('p ⇒ ('cF,'aF) φ) ⇒ ('c,'b) φ)
                             ⇒ ('p ⇒ ('cT,'aT) φ)
                             ⇒ ('a ⇒ bool)
                             ⇒ ('a ⇒ 'b ⇒ bool)
                             ⇒ bool›
  where ‹ Tyops_CommuteΛI F F' G G' T D r ⟷
            (∀x. D x ⟶ (x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y)) ›

definition Tyops_CommuteΛE :: ‹ (('p ⇒ ('cG,'aG) φ) ⇒ ('c,'a) φ)
                             ⇒ (('p ⇒ ('cT,'aT) φ) ⇒ ('cF,'aF) φ)
                             ⇒ (('cT,'aT) φ ⇒ ('cG,'aG) φ)
                             ⇒ (('cF,'aF) φ ⇒ ('c,'b) φ)
                             ⇒ ('p ⇒ ('cT,'aT) φ)
                             ⇒ ('a ⇒ bool)
                             ⇒ ('a ⇒ 'b ⇒ bool)
                             ⇒ bool›
  where ‹ Tyops_CommuteΛE F F' G G' T D r ⟷
            (∀x. D x ⟶ (x ⦂ F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y)) ›


subsection ‹Conventions›

subsubsection ‹General Groups of Properties›

φreasoner_group φtype_algebra_all_properties = (100, [0,4000]) for ‹_›
    ‹The universe group containing every sort of φ-type algebraic properties›
 and φTA_system_bottom = (1, [0,19]) for ‹_› in φtype_algebra_all_properties
    ‹Systematic rules of φ-type algebraic properties, of the lowest priority.›
 and φTA_fallback_lattice = (14, [10,19]) for ‹_› in φTA_system_bottom
    ‹Rules of φ-type algebraic forming a lattice giving fallbacks from weak properties to strong properties›
 and φtype_algebra_properties = (100, [20, 3800]) for ‹_› in φtype_algebra_all_properties
                                                          and > φTA_system_bottom
    ‹User rules of φ-type algebraic properties›
 and φTA_property = (1000, [1000, 1030]) for ‹_› in φtype_algebra_properties
    ‹Cutting rules›
 and φTA_derived_properties = (50, [50,50]) for ‹_› in φtype_algebra_properties
    ‹Automatically derived properties.›
 and φTA_varify_out = (3900, [3900,3900]) for ‹_› in φtype_algebra_all_properties and > φtype_algebra_properties
    ‹Systematic rules of φ-type algebraic properties that varifies OUT arguments that are not varibales›
 and φTA_commutativity = (100, [20, 3800]) for (‹Tyops_Commute F F' G G' T D r›,
                                                 ‹Tyops_Commute1_2 F F'T F'U G G' T U D r›,
                                                 ‹Tyops_Commute2_1 F F'T F'U G G' T U D r›)
                                            in φtype_algebra_properties
    ‹commutativities›
 and φTA_commutativity_default = (100, [100, 100]) in φTA_commutativity
    ‹rules not assigned with a specific priority and group›
 and φTA_derived_commutativity = (50,[50,50]) in φTA_commutativity and in φTA_derived_properties
    ‹commutativities. Note, because Tyops_Commute is also a tempalte property which may trigger
     instantiation of a lot templates. The deriviation should be prudent, which may provide templates
     to allow users to manually instantiation but registering to the φ-LPR only when the instantiated
     commutativity is certainly correct, because user overridings cannot override the rules
     instantiated by the derived commutativity to be overrided. ›

subsubsection ‹Groups for Specific Properties›

φreasoner_group Object_Sep_Homo_functor = (50, [50,50]) for (‹Object_Sep_HomoI T D›, ‹Object_Sep_HomoE T›)
                                                         in φtype_algebra_properties
    ‹Object_Sep_Homo for functors›

subsubsection ‹Derived Rules›

φreasoner_group deriving_local_rules = (200, [180,220]) for ‹_› > default
    ‹Local reasoning rules such as those extracted from induction hypotheses used during deriving.›

 and ToA_derived_one_to_one_functor = (70, [70,70]) for ‹x ⦂ F(T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ F(U)› in ToA_derived
    ‹Derived transformation in form ‹x ⦂ F(T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ F(U)›, of a high priority as this is what
     should be attempted in reasoning.›
 and To_ToA_derived_Tr_functor = (60, [60,60]) for ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r x y 𝗐𝗂𝗍𝗁 P @tag to U›
                                                in To_ToA_derived
    ‹Derived To-Transformation rules for transformation functor›
 and To_ToA_derived_Tr_functor_fuzzy = (55, [55,55]) for ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r x y 𝗐𝗂𝗍𝗁 P @tag to U›
                                                in To_ToA_derived and < To_ToA_derived_Tr_functor
    ‹when the annotated target φ-type is in the element algebra but not the container›
 and To_ToA_derived_to_raw = (60, [60,60]) for ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Itself 𝗌𝗎𝖻𝗃 y. r x y 𝗐𝗂𝗍𝗁 P @tag to Itself›
                                            in To_ToA_derived
    ‹Derived To-Transformation openning down the raw concrete representation›
 and φsimp_derived_Tr_functor = (40, [40,45]) for ‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜simp›
                                               in φsimp_derived
    ‹Derived transformation-based simplification for transformation functor›
 and φsimp_derived_bubbling = (60, [60,61]) for ‹x ⦂ F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YY @tag 𝒜simp›
    ‹Derived transformation-based simplification about bubbling›
 and derived_SE_functor = (70, [70,70]) for ‹x ⦂ F(T) ✼ F(W) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ F(U) ✼ F(R)› in ToA_derived
    ‹Derived rules of Separation Extraction, of a high priority as this is what
     should be attempted in reasoning. No confliction with %ToA_derived_one_to_one_functor›

φreasoner_group_assert identity_element_ToA < deriving_local_rules

paragraph ‹Separation Extraction on Semimodule›

φreasoner_group derived_SE_scalar_assoc = (30, [30,30]) for ‹x ⦂ F (a * b) T ✼ F (a * b) W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (c*d) U ✼ F (c*d) R›
                                              in ToA_derived and < derived_SE_functor
    ‹Derived rules for scalar associativity, of a low priority as  it can conflict to scalar distributive rule,
     see \cref{Semimodule-Scalar-Associative}›
 and derived_SE_scalar_distr = (35, [31, 39]) for ‹x ⦂ F (a + b) T ✼ F (a + b) W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (c+d) U ✼ F (c+d) R›
                                               in ToA_derived and > derived_SE_scalar_assoc and < derived_SE_functor
    ‹Derived rules for scalar distributivity.›
 and derived_SE_sdistr_comm_no_adz = (39, [39, 39]) in derived_SE_scalar_distr
    ‹scalar distributivity on commutative semigroup and non-zero scalar›
 and derived_SE_sdistr = (37, [37, 38]) in derived_SE_scalar_distr < derived_SE_sdistr_comm_no_adz
    ‹Derived rules for scalar distributivity on commutative semigroup›
 and derived_SE_sdistr_noassoc = (33, [33, 33]) in derived_SE_scalar_distr < derived_SE_sdistr
    ‹Derived rules for scalar distributivity on separational magma›
 and derived_SE_red_scalar_one = (30, [30,30]) for (‹x ⦂ F one T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U›, ‹y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ F one T›)
                                                in ToA_derived and < derived_SE_sdistr_noassoc
    ‹reduce scalar one›
 and derived_SE_inj_to_module = (27, [27,28]) for (‹x ⦂ F one T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U›, ‹y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ F one T›)
                                               in ToA_derived and < derived_SE_red_scalar_one
    ‹Derived rules lifting the target part into the module operator ‹F››
 and To_ToA_derived_SAssoc = (61, [61,61])
                             for (‹x ⦂ F st T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F s (F t T) 𝗌𝗎𝖻𝗃 y. r y @tag to (𝗌𝗉𝗅𝗂𝗍-𝖺𝗌𝗌𝗈𝖼 s t)›)
                             in To_ToA_derived
    ‹splitting a module by associativity›
 and To_ToA_derived_SDistri = (61, [61,61])
                              for (‹x ⦂ F st T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F t T ∗ F s T 𝗌𝗎𝖻𝗃 y. r y @tag to (𝗌𝗉𝗅𝗂𝗍-𝗌𝖼𝖺𝗅𝖺𝗋 s t)›)
                              in To_ToA_derived
    ‹splitting a module by scalar distributivity›

(*
subsubsection ‹Guess Algebraic Operators›

φreasoner_group guess_algebraic_oprs = (100, [0, 3000]) for ‹_›
    ‹A general group consisting of reasoning rules derivign or guessing operators for algbebraic properties›
 and guess_algebraic_oprs_default = (1000, [1000, 1030]) for ‹_› in guess_algebraic_oprs
    ‹Cutting rules derivign or guessing operators for algbebraic properties›
 and guess_algebraic_oprs_cut = (1000, [1000, 1030]) for ‹_› in guess_algebraic_oprs
    ‹Cutting rules derivign or guessing operators for algbebraic properties›
*)



subsubsection ‹Configurations›

φreasoner_group Semimodule_No_SDistr   = (1000, [1000,1000]) for ‹Semimodule_No_SDistr F› ‹›
            and Transformation_Functor = (1000, [1000,1000]) in φTA_property ‹›
            and Separation_Homo        = (1000, [1000,1000]) in φTA_property ‹›
            and Module_One         = (1000, [1000,1000]) in φTA_property ‹›
            and Module_Zero            = (1000, [1000,1000]) in φTA_property ‹›
            and Module_Assoc           = (1000, [1000,1000]) in φTA_property ‹›
            and Module_Distr      = (1000, [1000,1000]) in φTA_property ‹›


declare [[
  φdefault_reasoner_group
      ‹Tyops_Commute   F F' G G' T D R›        : %φTA_commutativity_default (100)
      ‹Tyops_Commute1_2 F F'T F'U G G' T U D r› : %φTA_commutativity_default (100)
      ‹Tyops_Commute2_1 F F'T F'U G G' T U D r› : %φTA_commutativity_default (100)
      ‹Tyops_CommuteΛI F F' G G' T D r›        : %φTA_commutativity_default (100)
      ‹Tyops_CommuteΛE F F' G G' T D r›        : %φTA_commutativity_default (100)

      ‹Transformation_Functor F1 F2 T U D R mapper›             : %Transformation_Functor (100)
      ‹Functional_Transformation_Functor Fa Fb T U D R pm fm›   : %Transformation_Functor (100)
      ‹Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 m›  : %Transformation_Functor (100)
      ‹Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pm fm› : %Transformation_Functor (100)
      ‹Transformation_FunctorΛ F1 F2 T U D R m›                 : %Transformation_Functor (100)
      ‹Functional_Transformation_FunctorΛ Fa Fb T U D R pm fm›  : %Transformation_Functor (100)
      ‹CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper›         : %Transformation_Functor (100)
      ‹Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pm fm›     : %Transformation_Functor (100)

      ‹Separation_HomoI Ft Fu F3 T U D z›                       : %Separation_Homo        (100)
      ‹Separation_HomoI2 Ft Fu F3 T1 T2 U1 U2 D z›               : %Separation_Homo        (100)
      ‹Separation_HomoE Ft Fu F3 T U Du un›                     : %Separation_Homo        (100)
      ‹Separation_HomoE2 Ft Fu F3 T1 T2 U1 U2 Du un›             : %Separation_Homo        (100)
      ‹Separation_HomoΛI Ft Fu F3 T U D z›                      : %Separation_Homo        (100)
      ‹Separation_HomoΛE Ft Fu F3 T U Du un›                    : %Separation_Homo        (100)

      ‹Module_Zero F zero›                                      : %Module_Zero            (100)
      ‹Closed_Module_Zero F zero›                               : %Module_Zero            (100)

      ‹Module_OneI F T1 one D f P›                              : %Module_One              (100)
      ‹Module_OneE F T1 one D f P›                              : %Module_One              (100)

      ‹Module_AssocI Fs Ft Fc T Ds Dt Dx smul f›                : %Module_Assoc           (100)
      ‹Module_AssocE Fs Ft Fc T Ds Dt Dx smul f›                : %Module_Assoc           (100)
      ‹Module_AssocΛI Fs Ft Fc T Ds Dt Dx smul f›               : %Module_Assoc           (100)
      ‹Module_AssocΛE Fs Ft Fc T Ds Dt Dx smul f›               : %Module_Assoc           (100)

      ‹Module_Distr_HomoZ F Ds Dx z›                            : %Module_Distr           (100)
      ‹Module_Distr_HomoS F Ds Dx uz›                           : %Module_Distr           (100)
]]


declare [[
  φpremise_attribute once? [φreason? %local] for ‹Transformation_Functor _ _ _ _ _ _ _›               (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Functional_Transformation_Functor _ _ _ _ _ _ _ _›  (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Transformation_FunctorΛ _ _ _ _ _ _ _›              (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Functional_Transformation_FunctorΛ _ _ _ _ _ _ _ _› (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _›     (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Functional_Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _ _› (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _›     (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Fun_CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _ _› (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _›     (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Fun_CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _ _› (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Object_Sep_HomoI _ _ ›                   (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Object_Sep_HomoE _ ›                     (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoI _ _ _ _ _ _ _›          (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoI2 _ _ _ _ _ _ _ _ _›          (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoE _ _ _ _ _ _ _›            (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoE2 _ _ _ _ _ _ _ _ _›          (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoI_Cond _ _ _ _ _ _ _ _›   (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoI2_Cond _ _ _ _ _ _ _ _ _ _›   (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoE_Cond _ _ _ _ _ _ _ _›   (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Separation_HomoE2_Cond _ _ _ _ _ _ _ _ _ _›   (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_Zero _ _ ›                    (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Closed_Module_Zero _ _ ›             (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_OneI _ _ _ _ _ _ ›            (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_OneE _ _ _ _ _ _ ›            (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_AssocI _ _ _ _ _ _ _ _ _ › (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_AssocE _ _ _ _ _ _ _ _ _ › (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_Distr_HomoZ _ _ _ _›             (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_Distr_HomoZ_rev _ _ _ _ _ _›     (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_Distr_HomoS _ _ _ _›             (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Module_Distr_HomoS_rev _ _ _ _ _ _›     (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Tyops_Commute _ _ _ _ _ _ _›                 (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Tyops_CommuteΛI _ _ _ _ _ _ _›      (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Tyops_CommuteΛE _ _ _ _ _ _ _›      (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Tyops_Commute1_2 _ _ _ _ _ _ _ _ _›  (%φattr),
  φpremise_attribute once? [φreason? %local] for ‹Tyops_Commute2_1 _ _ _ _ _ _ _ _ _›  (%φattr),

  φreason_default_pattern
      ‹Transformation_Functor ?Fa ?Fb _ _ _ _ _› ⇒
      ‹Transformation_Functor ?Fa _ _ _ _ _ _›
      ‹Transformation_Functor _ ?Fb _ _ _ _ _›   (100)
  and ‹Functional_Transformation_Functor ?Fa ?Fb _ _ _ _ _ _› ⇒
      ‹Functional_Transformation_Functor ?Fa _ _ _ _ _ _ _›
      ‹Functional_Transformation_Functor _ ?Fb _ _ _ _ _ _›   (100)
  and ‹Transformation_FunctorΛ ?Fa ?Fb _ _ _ _ _› ⇒
      ‹Transformation_FunctorΛ ?Fa _ _ _ _ _ _›
      ‹Transformation_FunctorΛ _ ?Fb _ _ _ _ _›   (100)
  and ‹Functional_Transformation_FunctorΛ ?Fa ?Fb _ _ _ _ _ _› ⇒
      ‹Functional_Transformation_FunctorΛ ?Fa _ _ _ _ _ _ _›
      ‹Functional_Transformation_FunctorΛ _ ?Fb _ _ _ _ _ _›   (100)
  and ‹Transformation_BiFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _› ⇒
      ‹Transformation_BiFunctor ?Fa _ _ _ _ _ _ _ _ _ _›
      ‹Transformation_BiFunctor _ ?Fb _ _ _ _ _ _ _ _ _›   (100)
  and ‹Functional_Transformation_BiFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _ _ › ⇒
      ‹Functional_Transformation_BiFunctor ?Fa _ _ _ _ _ _ _ _ _ _ _›
      ‹Functional_Transformation_BiFunctor _ ?Fb _ _ _ _ _ _ _ _ _ _›   (100)
  and ‹CV_TrFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _› ⇒
      ‹CV_TrFunctor ?Fa _ _ _ _ _ _ _ _ _ _›
      ‹CV_TrFunctor _ ?Fb _ _ _ _ _ _ _ _ _›   (100)
  and ‹Fun_CV_TrFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _ _ › ⇒
      ‹Fun_CV_TrFunctor ?Fa _ _ _ _ _ _ _ _ _ _ _›
      ‹Fun_CV_TrFunctor _ ?Fb _ _ _ _ _ _ _ _ _ _›   (100)
  and ‹Separation_HomoI ?Ft ?Fu ?Fc _ _ _ _› ⇒
      ‹Separation_HomoI ?Ft _ _ _ _ _ _›
      ‹Separation_HomoI _ ?Fu _ _ _ _ _›
      ‹Separation_HomoI _ _ ?Fc _ _ _ _›    (100)
  and ‹Separation_HomoI2 ?Ft ?Fu ?Fc _ _ _ _ _ _› ⇒
      ‹Separation_HomoI2 ?Ft _ _ _ _ _ _ _ _›
      ‹Separation_HomoI2 _ ?Fu _ _ _ _ _ _ _›
      ‹Separation_HomoI2 _ _ ?Fc _ _ _ _ _ _›    (100)
  and ‹Separation_HomoE ?Ft ?Fu ?Fc _ _ _ _› ⇒
      ‹Separation_HomoE _ _ ?Fc _ _ _ _›
      ‹Separation_HomoE _ ?Fu _ _ _ _ _›
      ‹Separation_HomoE ?Ft _ _ _ _ _ _›    (100)
  and ‹Separation_HomoE2 ?Ft ?Fu ?Fc _ _ _ _ _ _› ⇒
      ‹Separation_HomoE2 ?Ft _ _ _ _ _ _ _ _›
      ‹Separation_HomoE2 _ ?Fu _ _ _ _ _ _ _›
      ‹Separation_HomoE2 _ _ ?Fc _ _ _ _ _ _›    (100)
  and ‹Separation_HomoΛI ?Ft ?Fu ?Fc _ _ _ _› ⇒
      ‹Separation_HomoΛI ?Ft _ _ _ _ _ _›
      ‹Separation_HomoΛI _ ?Fu _ _ _ _ _›
      ‹Separation_HomoΛI _ _ ?Fc _ _ _ _›  (100)
  and ‹Separation_HomoΛE ?Ft ?Fu ?Fc _ _ _ _› ⇒
      ‹Separation_HomoΛE ?Ft _ _ _ _ _ _›
      ‹Separation_HomoΛE _ ?Fu _ _ _ _ _›
      ‹Separation_HomoΛE _ _ ?Fc _ _ _ _›    (100)
  and ‹Object_Sep_HomoI ?T _› ⇒ ‹Object_Sep_HomoI ?T _› (100)
  and ‹Separation_HomoI_Cond ?Ft ?Fu ?Fc _ _ _ _ _› ⇒
      ‹Separation_HomoI_Cond ?Ft _ _ _ _ _ _ _›
      ‹Separation_HomoI_Cond _ ?Fu _ _ _ _ _ _›
      ‹Separation_HomoI_Cond _ _ ?Fc _ _ _ _ _›  (100)
  and ‹Separation_HomoI2_Cond ?Ft ?Fu ?Fc _ _ _ _ _ _ _› ⇒
      ‹Separation_HomoI2_Cond ?Ft _ _ _ _ _ _ _ _ _›
      ‹Separation_HomoI2_Cond _ ?Fu _ _ _ _ _ _ _ _›
      ‹Separation_HomoI2_Cond _ _ ?Fc _ _ _ _ _ _ _›  (100)
  and ‹Separation_HomoE_Cond ?Ft ?Fu ?Fc _ _ _ _ _› ⇒
      ‹Separation_HomoE_Cond ?Ft _ _ _ _ _ _ _›
      ‹Separation_HomoE_Cond _ ?Fu _ _ _ _ _ _›
      ‹Separation_HomoE_Cond _ _ ?Fc _ _ _ _ _›  (100)
  and ‹Separation_HomoE2_Cond ?Ft ?Fu ?Fc _ _ _ _ _ _ _› ⇒
      ‹Separation_HomoE2_Cond ?Ft _ _ _ _ _ _ _ _ _›
      ‹Separation_HomoE2_Cond _ ?Fu _ _ _ _ _ _ _ _›
      ‹Separation_HomoE2_Cond _ _ ?Fc _ _ _ _ _ _ _›  (100)
  and ‹Separation_HomoΛI_Cond ?Ft ?Fu ?Fc _ _ _ _ _› ⇒
      ‹Separation_HomoΛI_Cond ?Ft _ _ _ _ _ _ _›
      ‹Separation_HomoΛI_Cond _ ?Fu _ _ _ _ _ _›
      ‹Separation_HomoΛI_Cond _ _ ?Fc _ _ _ _ _›  (100)
  and ‹Separation_HomoΛE_Cond ?Ft ?Fu ?Fc _ _ _ _ _› ⇒
      ‹Separation_HomoΛE_Cond ?Ft _ _ _ _ _ _ _›
      ‹Separation_HomoΛE_Cond _ ?Fu _ _ _ _ _ _›
      ‹Separation_HomoΛE_Cond _ _ ?Fc _ _ _ _ _›  (100)
  and ‹Module_Distr_HomoZ ?F _ _ _› ⇒ ‹Module_Distr_HomoZ ?F _ _ _› (100)
  and ‹Module_Distr_HomoS ?F _ _ _› ⇒ ‹Module_Distr_HomoS ?F _ _ _› (100)
  and ‹Module_Distr_HomoZ_rev ?F _ _ _ _ _› ⇒ ‹Module_Distr_HomoZ_rev ?F _ _ _ _ _› (100)
  and ‹Module_Distr_HomoS_rev ?F _ _ _ _ _› ⇒ ‹Module_Distr_HomoS_rev ?F _ _ _ _ _› (100)
  and ‹Semimodule_No_SDistr ?F› ⇒ ‹Semimodule_No_SDistr ?F› (100)
  and ‹Tyops_Commute ?F _ ?G _ ?T _ _› ⇒ ‹Tyops_Commute ?F _ ?G _ ?T _ _› (100)
  and ‹Tyops_CommuteΛI ?F _ ?G _ ?T _ _› ⇒ ‹Tyops_CommuteΛI ?F _ ?G _ ?T _ _› (100)
  and ‹Tyops_CommuteΛE ?F _ ?G _ ?T _ _› ⇒ ‹Tyops_CommuteΛE ?F _ ?G _ ?T _ _› (100)
  and ‹Tyops_Commute1_2 ?F _ _ ?G _ ?T ?U _ _› ⇒
      ‹Tyops_Commute1_2 ?F _ _ ?G _ ?T ?U _ _›   (100)
  and ‹Tyops_Commute2_1 ?F _ _ ?G _ ?T ?U _ _› ⇒
      ‹Tyops_Commute2_1 ?F _ _ ?G _ ?T ?U _ _›   (100)
]]


paragraph ‹Configuring Property Data Base›

(* hide_fact φinductive_destruction_rule_from_direct_definition
          φinductive_destruction_rule_from_direct_definition'
          φType_conv_eq_1 φType_conv_eq_2 φintro_transformation *)

setup ‹
let fun attach_var F =
      let val i = maxidx_of_term F + 1
       in case fastype_of F of Type‹fun T _› => F $ Var(("uu",i),T)
                             | _ => error "Impossible #8da16473-84ef-4bd8-9a96-331bcff88011"
      end
    open PLPR_Template_Properties
in (*Phi_Type.Detection_Rewr.setup_attribute binding‹φfunctor_of›
  "set the pattern rewrite to parse the functor part and the argument part from a term\
  \ matching the patter"
#>*)add_property_kinds [
  pattern_prop‹Transformation_Functor _ _ _ _ _ _ _›,
  pattern_prop‹Functional_Transformation_Functor _ _ _ _ _ _ _ _›,
  pattern_prop‹Transformation_FunctorΛ _ _ _ _ _ _ _›,
  pattern_prop‹Functional_Transformation_FunctorΛ _ _ _ _ _ _ _ _›,
  pattern_prop‹Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Functional_Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _ _›,
  pattern_prop‹CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Fun_CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoI _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoI2 _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoE _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoE2 _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoI_Cond _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoI2_Cond _ _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoE_Cond _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoE2_Cond _ _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoΛI _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoΛE _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoΛI_Cond _ _ _ _ _ _ _ _›,
  pattern_prop‹Separation_HomoΛE_Cond _ _ _ _ _ _ _ _›,
  pattern_prop‹Closed_Module_Zero _ _›,
  pattern_prop‹Module_Zero _ _›,
  pattern_prop‹Module_OneI _ _ _ _ _ _›,
  pattern_prop‹Module_OneE _ _ _ _ _ _›,
  pattern_prop‹Module_AssocI _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Module_AssocE _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Module_Distr_HomoZ _ _ _ _›,
  pattern_prop‹Module_Distr_HomoS _ _ _ _›,
  pattern_prop‹Semimodule_No_SDistr _›,
  pattern_prop‹Tyops_Commute _ _ _ _ _ _ _›,
  pattern_prop‹Tyops_CommuteΛI _ _ _ _ _ _ _›,
  pattern_prop‹Tyops_CommuteΛE _ _ _ _ _ _ _›,
  pattern_prop‹Tyops_Commute1_2 _ _ _ _ _ _ _ _ _›,
  pattern_prop‹Tyops_Commute2_1 _ _ _ _ _ _ _ _ _›
]

(*#> Phi_Type.add_property_kind const_name‹Object_Equiv› (fn (_ $ T $ _) => T)*)
― ‹We do not add Object_Equiv into the property-based template instantiation here because
  it can have special overridings for singular points like that many type operators ‹F› have a
  wider reachability relation at ‹F ○›. The overloadings multiply the resulted instantiations
  and they requires priority precedence which is not in the capability of the template
  instantiation automation.›
end
›
  
setup ‹
PLPR_Template_Properties.add_property_kinds [
  pattern_prop‹TERM (Identity_ElementsI _)›,
  pattern_prop‹TERM (Identity_ElementsE _)›
]

›

declare [[
  φreason_default_pattern ‹TERM (Identity_ElementsI ?F)› ⇒ ‹TERM (Identity_ElementsI ?FF)› (100)
                      and ‹TERM (Identity_ElementsE ?F)› ⇒ ‹TERM (Identity_ElementsE ?FF)› (100)
]]

text ‹Candidates of templates instantiation are not prioritized. When a property requires multiple
  rules ordered by their priorities for overrides and optimizations, the property is not declared
  as a parameter property in the template instantiation system but just a φ-LPR reasoning goal tagged
  by ‹𝒜_template_reason› in the template.
  Instead, a trigger ‹TERM (The_Property F)› is used as the parameter property activating
  the instantiation and (when the trigger is given) indicating when the prioritized rules are all given
  so when can the instantiation start. ›



subsection ‹Direct Applications \& Properties›

text ‹Directly applying the algebraic properties.›

subsubsection ‹Transformation Functor›

lemma Transformation_Functor_sub_dom:
  ‹ (⋀x. Da x ⊆ Db x)
⟹ Transformation_Functor F1 F2 T U Da R mapper
⟹ Transformation_Functor F1 F2 T U Db R mapper›
  unfolding Transformation_Functor_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_Functor_sub_rng:
  ‹ (⋀x. Rb x ⊆ Ra x)
⟹ Transformation_Functor F1 F2 T U D Ra mapper
⟹ Transformation_Functor F1 F2 T U D Rb mapper›
  unfolding Transformation_Functor_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_Functor_sub_mapper:
  ‹ ma ≤ mb
⟹ Transformation_Functor F1 F2 T U D R ma
⟹ Transformation_Functor F1 F2 T U D R mb›
  unfolding Transformation_Functor_def
  by (clarsimp simp add: le_fun_def Transformation_def Ball_def, blast)

lemma apply_Transformation_Functor:
  ‹ Transformation_Functor Fa Fb T U D R mapper
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D x ⟹ a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y ›
  unfolding Transformation_Functor_def Premise_def
  by simp

lemma apply_Functional_Transformation_Functor:
  ‹ Functional_Transformation_Functor Fa Fb T U D R pred_mapper func_mapper
⟹ (⋀a ∈ D x. 𝗎𝗌𝖾𝗋 a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a ⦂ U 𝗐𝗂𝗍𝗁 P a)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a. a ∈ D x ⟶ f a ∈ R x) 
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x ⦂ Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x›
  unfolding meta_Ball_def Argument_def Premise_def
            Functional_Transformation_Functor_def Transformation_Functor_def
  by clarsimp


subsubsection ‹Transformation Bi-Functor›

lemma Transformation_BiFunctor_sub_dom:
  ‹ (⋀x. D1 x ⊆ D1' x)
⟹ (⋀x. D2 x ⊆ D2' x)
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1' D2' R1 R2 mapper›
  unfolding Transformation_BiFunctor_def
  by (clarsimp simp add: subset_iff; blast)

lemma CV_TrFunctor_sub_dom:
  ‹ (⋀x. D1 x ⊆ D1' x)
⟹ (⋀x. D2 x ⊆ D2' x)
⟹ CV_TrFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ CV_TrFunctor F1 F2 T1 T2 U1 U2 D1' D2' R1 R2 mapper›
  unfolding CV_TrFunctor_def
  by (clarsimp simp add: subset_iff; smt)

lemma Transformation_BiFunctor_sub_rng:
  ‹ (⋀x. R1' x ⊆ R1 x)
⟹ (⋀x. R2' x ⊆ R2 x)
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1  R2  mapper
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1' R2' mapper›
  unfolding Transformation_BiFunctor_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_BiFunctor_sub_mapper:
  ‹ ma ≤ mb
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 ma
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mb›
  unfolding Transformation_BiFunctor_def le_fun_def Transformation_def
  by (clarsimp simp add: Ball_def; smt (verit, best))

lemma apply_Transformation_BiFunctor:
  ‹ Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D1 x ⟹ a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b)
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D2 x ⟹ a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y ›
  unfolding Transformation_BiFunctor_def Premise_def
  by simp

(*
lemma apply_CV_TrFunctor:
  ‹ CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∃b. g1 a b ∧ b ∈ D1 x) ⟹ a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 a b)
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D2 x ⟹ a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. b ∈ D1 x ∧ g1 a b ⟶ a ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y ›
  unfolding CV_TrFunctor_def Premise_def
  by simp
*)

lemma apply_Functional_Transformation_BiFunctor:
  ‹ Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pred_mapper func_mapper
⟹ (⋀a ∈ D1 x. 𝗎𝗌𝖾𝗋 a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ U1 𝗐𝗂𝗍𝗁 P1 a)
⟹ (⋀a ∈ D2 x. 𝗎𝗌𝖾𝗋 a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 𝗐𝗂𝗍𝗁 P2 a)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a. a ∈ D1 x ⟶ f1 a ∈ R1 x) ∧ (∀a. a ∈ D2 x ⟶ f2 a ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x ⦂ Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x›
  unfolding meta_Ball_def Argument_def Premise_def
            Functional_Transformation_BiFunctor_def Transformation_Functor_def
  by clarsimp

lemma apply_Functional_CV_BiFunctor:
  ‹ Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pred_mapper func_mapper
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 f1 a ∈ D1 x ⟹ 𝗎𝗌𝖾𝗋 a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ T1 𝗐𝗂𝗍𝗁 P1 a)
⟹ (⋀a ∈ D2 x. 𝗎𝗌𝖾𝗋 a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 𝗐𝗂𝗍𝗁 P2 a)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 FC1 f1 x ∧ (∀a. a ∈ D2 x ⟶ f2 a ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x ⦂ Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x›
  unfolding meta_Ball_def Argument_def Premise_def
            Fun_CV_TrFunctor_def Transformation_Functor_def
  by clarsimp


subsubsection ‹Transformation Functor with Parameterization›

lemma Transformation_FunctorΛ_sub_dom:
  ‹ (⋀p x. Da p x ⊆ Db p x)
⟹ Transformation_FunctorΛ F1 F2 T U Da R mapper
⟹ Transformation_FunctorΛ F1 F2 T U Db R mapper›
  unfolding Transformation_FunctorΛ_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_FunctorΛ_sub_rng:
  ‹ (⋀p x. Rb p x ⊆ Ra p x)
⟹ Transformation_FunctorΛ F1 F2 T U D Ra mapper
⟹ Transformation_FunctorΛ F1 F2 T U D Rb mapper›
  unfolding Transformation_FunctorΛ_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_FunctorΛ_sub_mapper:
  ‹ ma ≤ mb
⟹ Transformation_FunctorΛ F1 F2 T U D R ma
⟹ Transformation_FunctorΛ F1 F2 T U D R mb›
  unfolding Transformation_FunctorΛ_def
  by (clarsimp simp add: le_fun_def Transformation_def Ball_def, blast)

lemma apply_Transformation_FunctorΛ:
  ‹ Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ (⋀p a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D p x ⟹ a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y ›
  unfolding Transformation_FunctorΛ_def Premise_def Transformation_def
  by clarsimp

lemma apply_Functional_Transformation_FunctorΛ:
  ‹ Functional_Transformation_FunctorΛ Fa Fb T U D R pred_mapper func_mapper
⟹ (⋀p. ⋀a ∈ D p x. 𝗎𝗌𝖾𝗋 a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a ⦂ U p 𝗐𝗂𝗍𝗁 P p a)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a. a ∈ D p x ⟶ f p a ∈ R p x) 
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x ⦂ Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x›
  unfolding meta_Ball_def Argument_def Premise_def Functional_Transformation_FunctorΛ_def
  by clarsimp


subsubsection ‹Separation Homo / Functor›

lemma apply_sep_homo:
  ‹ Object_Sep_HomoI T D
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (x,y) ∈ D
⟹ (x ⦂ T) * (y ⦂ T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x * y ⦂ T 𝗐𝗂𝗍𝗁 x ## y›
  unfolding Object_Sep_HomoI_def Premise_def by simp

lemma apply_sep_homo_unzip:
  ‹ Object_Sep_HomoE T
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ## y
⟹ (x * y ⦂ T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x ⦂ T) * (y ⦂ T)›
  unfolding Object_Sep_HomoE_def Premise_def by blast

lemma Separation_HomoI_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoI Fa Fb Fc T U D  z
⟹ Separation_HomoI Fa Fb Fc T U D' z›
  unfolding Separation_HomoI_def
  by blast

lemma Separation_HomoI2_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoI2 Fa Fb Fc T1 T2 U1 U2 D  z
⟹ Separation_HomoI2 Fa Fb Fc T1 T2 U1 U2 D' z›
  unfolding Separation_HomoI2_def
  by blast


lemma Separation_HomoI_Cond_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoI_Cond Fa Fb Fc CW T U D  z
⟹ Separation_HomoI_Cond Fa Fb Fc CW T U D' z›
  unfolding Separation_HomoI_Cond_def
  by blast


lemma Separation_HomoI_Cond2_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoI2_Cond Fa Fb Fc CW T1 T2 U1 U2 D  z
⟹ Separation_HomoI2_Cond Fa Fb Fc CW T1 T2 U1 U2 D' z›
  unfolding Separation_HomoI2_Cond_def
  by blast


lemma Separation_HomoE_Cond_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoE_Cond Fa Fb Fc CR T U D  z
⟹ Separation_HomoE_Cond Fa Fb Fc CR T U D' z›
  unfolding Separation_HomoE_Cond_def
  by blast

lemma apply_Separation_HomoI:
  ‹ Separation_HomoI Ft Fu Fc T U D z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Ft(T) ∗ Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x ⦂ Fc(T ∗ U)›
  unfolding Separation_HomoI_def Premise_def meta_Ball_def meta_case_prod_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoI2 :
  ‹ Separation_HomoI2 Ft Fu Fc T1 T2 U1 U2 D z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Ft T1 T2 ∗ Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x ⦂ Fc (T1 ∗ U1) (T2 ∗ U2) ›
  unfolding Separation_HomoI2_def Premise_def meta_Ball_def meta_case_prod_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoE:
  ‹ Separation_HomoE Ft Fu Fc T U Du un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Du
⟹ x ⦂ Fc(T ∗ U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x ⦂ Ft(T) ∗ Fu(U)›
  unfolding Separation_HomoE_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoE2:
  ‹ Separation_HomoE2 Ft Fu Fc T1 T2 U1 U2 Du un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Du
⟹ x ⦂ Fc (T1 ∗ U1) (T2 ∗ U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x ⦂ Ft T1 T2 ∗ Fu U1 U2›
  unfolding Separation_HomoE2_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoI_Cond:
  ‹ Separation_HomoI_Cond Ft Fu Fc C T U D z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Ft T ∗ ◒[C] Fu U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x ⦂ Fc (T ∗ ◒[C] U)›
  unfolding Separation_HomoI_Cond_def Premise_def split_paired_all
  by (cases x; simp)


lemma apply_Separation_HomoI2_Cond:
  ‹ Separation_HomoI2_Cond Ft Fu Fc CR T1 T2 U1 U2 D z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Ft T1 T2 ∗ ◒[CR] Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x ⦂ Fc (T1 ∗ ◒[CR] U1) (T2 ∗ ◒[CR] U2) ›
  unfolding Separation_HomoI2_Cond_def Premise_def split_paired_all
  by (cases x; simp)

(*
lemma apply_Separation_HomoI_Cond3':
  ‹ Separation_HomoI_Cond FT FU FTU CU T U D1 z1
⟹ Separation_HomoI_Cond FTU FW F3 CW (T ∗[CU] U) W D2 z2
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 fst x ∈ D1 ∧ apfst z1 x ∈ D2
⟹ x ⦂ (FT T ∗[CU] FU U) ∗[CW] FW W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z2 (apfst z1 x) ⦂ F3 ((T ∗[CU] U) ∗[CW] W) ›
  unfolding Separation_HomoI_Cond_def Premise_def split_paired_all Transformation_def
  by (cases CU; cases CW; cases x; simp; metis prod.collapse)
*)

lemma apply_Separation_HomoE_Cond:
  ‹ Separation_HomoE_Cond Ft Fu Fc C T U D un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Fc (T ∗ ◒[C] U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x ⦂ Ft T ∗ ◒[C] Fu U›
  unfolding Separation_HomoE_Cond_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoE2_Cond:
  ‹ Separation_HomoE2_Cond Ft Fu Fc C T1 T2 U1 U2 D un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Fc (T1 ∗ ◒[C] U1) (T2 ∗ ◒[C] U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x ⦂ Ft T1 T2 ∗ ◒[C] Fu U1 U2›
  unfolding Separation_HomoE2_Cond_def φProd_expn'[symmetric] Premise_def
  by simp

paragraph ‹With Parameterization›

lemma Separation_HomoΛI_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoΛI Fa Fb Fc T U D  z
⟹ Separation_HomoΛI Fa Fb Fc T U D' z›
  unfolding Separation_HomoΛI_def
  by blast

lemma Separation_HomoΛI_Cond_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoΛI_Cond Fa Fb Fc CW T U D  z
⟹ Separation_HomoΛI_Cond Fa Fb Fc CW T U D' z›
  unfolding Separation_HomoΛI_Cond_def
  by blast

lemma Separation_HomoΛE_Cond_sub_D:
  ‹ D' ⊆ D
⟹ Separation_HomoΛE_Cond Fa Fb Fc CR T U D  z
⟹ Separation_HomoΛE_Cond Fa Fb Fc CR T U D' z›
  unfolding Separation_HomoΛE_Cond_def
  by blast

lemma apply_Separation_HomoΛI:
  ‹ Separation_HomoΛI Ft Fu Fc T U D z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Ft(T) ∗ Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x ⦂ Fc(λp. T p ∗ U p)›
  unfolding Separation_HomoΛI_def Premise_def meta_Ball_def meta_case_prod_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoΛE:
  ‹ Separation_HomoΛE Ft Fu Fc T U Du un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Du
⟹ x ⦂ Fc(λp. T p ∗ U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x ⦂ Ft(T) ∗ Fu(U)›
  unfolding Separation_HomoΛE_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoΛI_Cond:
  ‹ Separation_HomoΛI_Cond Ft Fu Fc CR T U D z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Ft(T) ∗ ◒[CR] Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x ⦂ Fc(λp. T p ∗ ◒[CR] U p)›
  unfolding Separation_HomoΛI_Cond_def Premise_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoΛE_Cond:
  ‹ Separation_HomoΛE_Cond Ft Fu Fc CW T U D un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ D
⟹ x ⦂ Fc(λp. T p ∗ ◒[CW] U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x ⦂ Ft(T) ∗ ◒[CW] Fu(U)›
  unfolding Separation_HomoΛE_Cond_def φProd_expn'[symmetric] Premise_def
  by simp


subsubsection ‹Semimodule›

paragraph ‹Association›

lemma apply_Semimodule_SAssocI:
  ‹ Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Dt t ∧ Dx s t x
⟹ x ⦂ Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fc (smul s t) T ›
  unfolding Module_AssocI_def Premise_def
  by clarsimp

lemma apply_Semimodule_SAssocE:
  ‹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Dt t ∧ Dx s t x
⟹ x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fs s (Ft t T) ›
  unfolding Module_AssocE_def Premise_def
  by clarsimp


paragraph ‹Identity Element›

lemma apply_Module_OneI:
  ‹ Module_OneI F T1 one D f P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F one 𝗐𝗂𝗍𝗁 P x ›
  unfolding Module_OneI_def Premise_def
  by simp

(*
lemma apply_Module_OneI_φSome:
  ‹ Module_OneI F T1 one D f P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ ● T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ ● F one 𝗐𝗂𝗍𝗁 P x ›
  unfolding Module_OneI_def Premise_def φSome_transformation_strip
  by simp
*)

lemma apply_Module_OneE:
  ‹ Module_OneE F T1 one D f P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ T1 𝗐𝗂𝗍𝗁 P x ›
  unfolding Module_OneE_def Premise_def
  by simp

(*
lemma apply_Module_OneE_φSome:
  ‹ Module_OneE F T1 one D f P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ ● F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ ● T1 𝗐𝗂𝗍𝗁 P x ›
  unfolding Module_OneE_def Premise_def φSome_transformation_strip
  by simp
*)


paragraph ‹Left Distributivity›

lemma Module_Distr_HomoZ_sub:
  ‹ Ds ≤ Ds' ∧ Dx ≤ Dx'
⟹ Module_Distr_HomoZ F Ds' Dx' z
⟹ Module_Distr_HomoZ F Ds Dx z›
  unfolding Module_Distr_HomoZ_def le_fun_def le_bool_def
  by blast

lemma [φadding_property = false,
       φreason %φTA_varify_out except ‹Module_Distr_HomoZ _ ?var_Ds ?var_Dx _›,
       φadding_property = true ]:
  ‹ Module_Distr_HomoZ F Ds' Dx' z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds ≤ Ds' ∧ Dx ≤ Dx'
⟹ Module_Distr_HomoZ F Ds Dx z›
  unfolding Premise_def
  using Module_Distr_HomoZ_sub by blast

lemma apply_Module_Distr_HomoZ:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ F s ∗ F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ F (s + t) ›
  unfolding Module_Distr_HomoZ_def Premise_def
  by blast

(*
lemma apply_Module_Distr_HomoZ_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ ● F s ∗ ● F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ ● F (s + t) ›
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
  by (clarsimp; metis prod.collapse)
*)

lemma apply_Module_Distr_HomoZ_RCond_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C ⟶ Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x) ∧ ?+ True r = ?+ True s + ?+ C t
⟹ x ⦂ F s ∗ ◒[C] F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?jR C (z s t) x ⦂ F r ›
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
  by (cases C; clarsimp; metis prod.collapse)

lemma apply_Module_Distr_HomoZ_LCond_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C ⟶ Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x) ∧ ?+ True r = ?+ C s + ?+ True t
⟹ x ⦂ ◒[C] F s ∗ F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?jL C (z s t) x ⦂ F r ›
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
  by (cases C; clarsimp; metis prod.collapse)


lemma apply_Module_Distr_HomoZ_rev:
  ‹ Module_Distr_HomoZ F Ds Dx' z'
⟹ Module_Distr_HomoZ_rev F Ds Dx' z' Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x
⟹ x ⦂ F s ∗ F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ F (t + s) ›
  unfolding Module_Distr_HomoZ_rev_def Premise_def
  by blast

(*
lemma apply_Module_Distr_HomoZ_rev_LCond_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx' z'
⟹ Module_Distr_HomoZ_rev F Ds Dx' z' Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C ⟶ Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x) ∧ ?+ True r = ?+ C t + ?+ True s
⟹ x ⦂ ● F s ∗ ◒[C] F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?jR C (z s t) x ⦂ ● F r ›
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
            Module_Distr_HomoZ_rev_def
  by (cases C; clarsimp; metis prod.collapse)

lemma apply_Module_Distr_HomoZ_rev_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx' z'
⟹ Module_Distr_HomoZ_rev F Ds Dx' z' Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x
⟹ x ⦂ ● F s ∗ ● F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ ● F (t + s) ›
  unfolding Module_Distr_HomoZ_rev_def Premise_def Transformation_def
  by (clarsimp; metis prod.collapse)
*)

lemma apply_Module_Distr_HomoS:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s ∗ F t ›
  unfolding Module_Distr_HomoS_def Premise_def
  by blast

(*
lemma apply_Module_Distr_HomoS_φSome:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ ● F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ ● F s ∗ ● F t ›
  unfolding Module_Distr_HomoS_def Premise_def Transformation_def
  by (clarsimp; metis sep_disj_option(1) times_option(1))
*)

lemma apply_Module_Distr_HomoS_RCond:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C ⟶ Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x) ∧
           ?+ True r = ?+ True s + ?+ C t
⟹ x ⦂ F r 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?sR C (uz s t) x ⦂ F s ∗ ◒[C] F t ›
  unfolding Premise_def Module_Distr_HomoS_def Transformation_def
  by (cases C; clarsimp; metis sep_disj_option(1) times_option(1))

lemma apply_Module_Distr_HomoS_LCond:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C ⟶ Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x) ∧
           ?+ True r = ?+ C s + ?+ True t
⟹ x ⦂ F r 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?sL C (uz s t) x ⦂ ◒[C] F s ∗ F t ›
  unfolding Premise_def Module_Distr_HomoS_def Transformation_def
  by (cases C; clarsimp; metis sep_disj_option(1) times_option(1))

lemma apply_Module_Distr_HomoS_rev:
  ‹ Module_Distr_HomoS F Ds Dx' uz'
⟹ Module_Distr_HomoS_rev F Dx' uz' Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x
⟹ x ⦂ F (t + s) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s ∗ F t ›
  unfolding Module_Distr_HomoS_rev_def Premise_def
  by blast


subsubsection ‹Swap \& Assoc Normalization›

φreasoner_group φToA_SA_norm = (1000, [10,2000]) in φsimp_all
      ‹normalize the φ-type by swapping, as that specified by ‹φToA_swap_normalization››
  and φToA_SA_derived = (50, [50, 50]) in φsimp_derived and in φToA_SA_norm
                                              and > φsimp_derived_Tr_functor
      ‹derived›


ML_file ‹library/phi_type_algebra/commutativity.ML›
(*ML_file ‹library/phi_type_algebra/weight.ML›*)

definition Require_Swap_Norm :: ‹('c,'a) φ ⇒ bool›
  where ‹Require_Swap_Norm F_G_T ≡ True›
    ― ‹a pure syntactical checking for whether ‹F› should be swapped into ‹G›, in ‹F(G(T))›,
        or any multi-arity version›

definition Not_Require_Swap_Norm :: ‹('c,'a) φ ⇒ bool›
  where ‹Not_Require_Swap_Norm F_G_T ≡ True›

definition Require_Assoc_Norm :: ‹('c,'a) φ ⇒ bool ⇒ bool›
  where ‹Require_Assoc_Norm F_G_T direction ≡ True›
  ― ‹‹direction = True› for using intro rules only ; ‹False› for elim rules only›

definition Not_Require_Assoc_Norm :: ‹('c,'a) φ ⇒ bool ⇒ bool›
  where ‹Not_Require_Assoc_Norm F_G_T direction ≡ True›

definition Require_SA_Norm :: ‹('c,'a) φ ⇒ bool ⇒ bool›
  where ‹Require_SA_Norm F_G_T direction ≡ Require_Swap_Norm F_G_T ∨ Require_Assoc_Norm F_G_T direction ›

definition Not_Require_SA_Norm :: ‹('c,'a) φ ⇒ bool ⇒ bool›
  where ‹Not_Require_SA_Norm F_G_T direction ≡ Not_Require_Swap_Norm F_G_T ∧ Not_Require_Assoc_Norm F_G_T direction ›
  

φreasoner_ML Require_Swap_Norm %cutting (‹Require_Swap_Norm _›) = ‹ fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T)) =>
             (bvtys, F_G_T)
   in if Phi_Type.whether_to_swap_normalize (Context.Proof ctxt) bvs F_G_T
      then SOME ((ctxt, @{lemma' ‹Require_Swap_Norm F› by (simp add: Require_Swap_Norm_def)} RS sequent), Seq.empty)
      else NONE
  end)
›

φreasoner_ML Not_Require_Swap_Norm %cutting (‹Not_Require_Swap_Norm _›) = ‹ fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Not_Require_Swap_Norm*) $ F_G_T)) =>
             (bvtys, F_G_T)
   in if Phi_Type.whether_to_swap_normalize (Context.Proof ctxt) bvs F_G_T
      then NONE
      else SOME ((ctxt, @{lemma' ‹Not_Require_Swap_Norm F› by (simp add: Not_Require_Swap_Norm_def)} RS sequent), Seq.empty)
  end)
›

φreasoner_ML Require_Assoc_Norm %cutting (‹Require_Assoc_Norm _ _›) = ‹ fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of Const‹True› => Phi_Type.AD_INTRO
                                             | Const‹False› => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Require_Assoc_Norm", [direction])))
   in if Phi_Type.whether_to_assoc_normalize (Context.Proof ctxt) direction bvs F_G_T
      then SOME ((ctxt, @{lemma' ‹Require_Assoc_Norm F Any› by (simp add: Require_Assoc_Norm_def)} RS sequent), Seq.empty)
      else NONE
  end)
›

φreasoner_ML Not_Require_Assoc_Norm %cutting (‹Not_Require_Assoc_Norm _ _›) = ‹ fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of Const‹True› => Phi_Type.AD_INTRO
                                             | Const‹False› => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Require_Assoc_Norm", [direction])))
   in if Phi_Type.whether_to_assoc_normalize (Context.Proof ctxt) direction bvs F_G_T
      then NONE
      else SOME ((ctxt, @{lemma' ‹Not_Require_Assoc_Norm F Any› by (simp add: Not_Require_Assoc_Norm_def)} RS sequent), Seq.empty)
  end)
›

φreasoner_ML Require_SA_Norm %cutting (‹Require_SA_Norm _ _›) = ‹ fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of Const‹True› => Phi_Type.AD_INTRO
                                             | Const‹False› => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Require_SA_Norm", [direction])))
   in if Phi_Type.whether_to_SA_normalize (Context.Proof ctxt) direction bvs F_G_T
      then SOME ((ctxt, @{lemma' ‹Require_SA_Norm F Any›
                             by (simp add: Require_SA_Norm_def Require_Assoc_Norm_def )} RS sequent), Seq.empty)
      else NONE
  end)
›

φreasoner_ML Not_Require_SA_Norm %cutting (‹Not_Require_SA_Norm _ _›) = ‹ fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of Const‹True› => Phi_Type.AD_INTRO
                                             | Const‹False› => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Not_Require_SA_Norm", [direction])))
   in if Phi_Type.whether_to_SA_normalize (Context.Proof ctxt) direction bvs F_G_T
      then NONE
      else SOME ((ctxt, @{lemma' ‹Not_Require_SA_Norm F Any›
                             by (simp add: Not_Require_SA_Norm_def Not_Require_Assoc_Norm_def Not_Require_Swap_Norm_def )}
                        RS sequent), Seq.empty)
  end)
›


subsection ‹Programming Methods to Prove the Properties›


subsubsection ‹Transformation Functor›

lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀x g.
            ∀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b
        ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
        ⟹ x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Transformation_Functor F1 F2 T U D R mapper)) MM DD RR FF›
  unfolding φProgramming_Method_def Transformation_Functor_def Premise_def
  by clarsimp

lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀x g1 g2.
            ∀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b
        ⟹ ∀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b
        ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
        ⟹ x ⦂ F1 T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper)) MM DD RR FF›
  unfolding φProgramming_Method_def Transformation_BiFunctor_def Premise_def
            Transformation_def
  by (simp add: atomize_imp atomize_all)


subsubsection ‹Separation Homo›

(* TODO
lemma
  ‹ PROP φProgramming_Method (⋀T U x g.
            ∀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b
        ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
        ⟹ x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Separation_HomoI Ft Fu Fc D R mapper)) MM DD RR FF › *)


subsubsection ‹Semimodule Functor›

lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀s t x y.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t (x,y)
          ⟹ (x ⦂ F s) * (y ⦂ F t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t (x,y) ⦂ F (s + t)
        ) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Module_Distr_HomoZ F Ds Dx z)) MM DD RR FF›
  unfolding φProgramming_Method_def Module_Distr_HomoZ_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')

(* all be deduced from ‹Module_Distr_HomoZ› and no need to go to programming
lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀s t x y.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds t ∧ Ds s ∧ t ##+ s ∧ Dx t s (x,y)
          ⟹ (y ⦂ F s T) * (x ⦂ F t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z t s (x,y) ⦂ F (t + s) T
        ) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Module_Distr_HomoZ_rev F T Ds Dx z)) MM DD RR FF›
  unfolding φProgramming_Method_def Module_Distr_HomoZ_rev_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')
*)

lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀s t x.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
          ⟹ x ⦂ F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s ∗ F t
        ) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Module_Distr_HomoS F Ds Dx uz)) MM DD RR FF›
  unfolding φProgramming_Method_def Module_Distr_HomoS_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')

(* all be deduced from ‹Module_Distr_HomoZ› and no need to go to programming
lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀s t x.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
          ⟹ x ⦂ F (s + t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s T ∗ F t T
        ) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Module_Distr_HomoS_rev F T Ds Dx uz)) MM DD RR FF›
  unfolding φProgramming_Method_def Module_Distr_HomoS_rev_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')
*)



section ‹Definition and Deriving Tools for φ-Types›

text ‹The @{command φtype_def} command always generate 4 sorts of rules.
  For instance, for definition ‹x ⦂ T ≡ U›,

▪ ▩‹T.intro› of form prop‹U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T›. There are corresponding reasoning rules named ▩‹T.intro_reasoning›.
      By default the reasoning rules are not activated. You may activate them by
      ▩‹declare T.intro_reasoning[φreason]› in order to, for instance, reduce to ‹U› the reasoning of
      ∗‹every› transformation goal targeting to ‹T›. Depending on the priority you configured,
      if the priority is greater than 54 (the priority of the entry point of the Structural Extraction),,
      this reduction happens before any in-depth reasoning that collects proportions in the source
      objects to synthesis the target ‹T› (i.e. the Structural Extraction, SE);
      if the priority is less than 50, it serves as a fallback when the SE fails.

      In any case even if you do not activate the intro rule, the system always activates a rule
      that allows you to use term‹MAKE T› tag to invoke the intro rule and to make a φ-type term
      of ‹T› from ‹U›. To use it, just write φ-Lang ▩‹‹x ⦂ MAKE T›› to invoke the synthesis process.

▪ ▩‹T.elim› of form prop‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U›. There are also corresponding reasoning rules named ▩‹T.elim_reasoning›.
      They are also not activated by default. The priority of them can be more arbitrary because they are
      in the SE process as the last stage of the ∃free-ToA reasoning. Note the ∃free-ToA reasoning
      works not good if the elim rule introduces existential quantification, because the ∃free-ToA
      by design does not consider opening abstraction.

      No matter if the reasoning rules are activated, you can always open an abstraction using
      To-Transformation, i.e., φ-Lang ▩‹to ‹List OPEN›› for instance to open ‹x" ⦂ List T› into
      ‹{ y" ⦂ List U' | List.rel P x" y" }› if ‹U ≡ { y ⦂ U' | P y }› for some ‹y› and ‹y"› that
      maybe in a set if ‹x ⦂ T› is an abstraction of a set of ‹ { y ⦂ U' | P y } ›.

▪ ▩‹T.unfold›, prop‹(x ⦂ T) = U›

▪ ▩‹T.expansion›, prop‹p ⊨ (x ⦂ T) ⟷ p ⊨ U›. This rule is added to the system global simplifier.

If a definition like those recursive definitions is characterized by multiple equations.
The above rules are generated for each equation correspondingly.
›

subsection ‹Implementation›

paragraph ‹Templates Generating Rules›

(*
lemma φinductive_destruction_rule_from_direct_definition:
  ‹ (x ⦂ T) = U
⟹ P ⟶ (R * U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q)
⟹ P ⟶ (R * (x ⦂ T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q) ›
  by simp

lemma φinductive_destruction_rule_from_direct_definition':
  ‹ (x ⦂ T) = U
⟹ P ⟶ (U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q)
⟹ P ⟶ (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q) ›
  by simp
*)

subparagraph ‹Intro and Elim reasoning rules›

lemma φintro_transformation:
  ‹ (x ⦂ T) = U
⟹ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T ›
  by simp

lemma φintro_reasoning_transformation:
  ‹ (x ⦂ T) = U
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗐𝗂𝗍𝗁 P ›
  by simp

text ‹The generated intro-rule is in ‹x ⦂ T ∗[C] R› form to the best which is the most general
      and falls back to ‹x ⦂ T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R› if the definition cannot be rewrote to type form ‹x ⦂ T ≡ y ⦂ U›.

Priorities: ‹φintro'_reasoning_transformation_ty_var› >
            ‹φintro'_reasoning_transformation_ty› >
            ‹φintro'_reasoning_transformation›
›

lemma φintro'_reasoning_transformation:
  ‹ (x ⦂ T) = U
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P ›
  by simp

lemma φintro'_reasoning_transformation_ty:
  ‹ (x ⦂ T) = (y ⦂ U)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 yr ⦂ U ✼ R 𝗐𝗂𝗍𝗁 P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 fst yr = y
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x, snd yr) ⦂ T ✼ R 𝗐𝗂𝗍𝗁 P ›
  unfolding Premise_def φProd'_def
  by (cases yr; simp add: φProd_expn')

lemma φelim_transformation:
  ‹ (x ⦂ T) = U
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U ›
  by simp

lemma φelim_reasoning_transformation:
  ‹ (x ⦂ T) = U
⟹ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
  by simp

lemma φelim'SEi_transformation:
  ‹ (⋀x. (x ⦂ T) = (y x ⦂ U x))
⟹ (y (fst x), snd x) ⦂ U (fst x) ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ T ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
  by (cases x; simp add: φProd_expn' φProd'_def)


lemma φintro_ToA_Mapper_template:
  ‹ (⋀x. (x ⦂ T ) = (ψ  x ⦂ S ))
⟹ (⋀x. (x ⦂ T') = (ψ' x ⦂ S'))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀x∈(f o ψ) `D. ψ' (φ' x) = x)
⟹ 𝗆𝖺𝗉 g : U ↦ U' 𝗈𝗏𝖾𝗋 f : S ↦ S' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 ψ ` D
⟹ 𝗆𝖺𝗉 g : U ↦ U' 𝗈𝗏𝖾𝗋 φ' o f o ψ : T ↦ T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o ψ 𝗌𝖾𝗍𝗍𝖾𝗋 φ' o s 𝗂𝗇 D ›
  unfolding ToA_Mapper_def Premise_def
  by clarsimp

lemma φintro_ToA_Mapper_template_SE:
  ‹ (⋀x. (x ⦂ T ) = (ψ  x ⦂ S ))
⟹ (⋀x. (x ⦂ T') = (ψ' x ⦂ S'))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀x∈(f o ψ o fst) `D. ψ' (φ' x) = x)
⟹ 𝗆𝖺𝗉 g : U ↦ U' 𝗈𝗏𝖾𝗋 f ⊗f w : S ✼ W ↦ S' ✼ W' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 apfst ψ ` D
⟹ 𝗆𝖺𝗉 g : U ↦ U' 𝗈𝗏𝖾𝗋 (φ' o f o ψ) ⊗f w : T ✼ W ↦ T' ✼ W' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o apfst ψ 𝗌𝖾𝗍𝗍𝖾𝗋 apfst φ' o s 𝗂𝗇 D ›
  unfolding ToA_Mapper_rev_def Premise_def φProd'_def
  apply (clarsimp simp: φProd_expn' φProd_expn'' ball_conj_distrib[symmetric])
  subgoal premises prems for a b
    by (insert prems(1,2,5) prems(3,4)[THEN bspec[where x=‹(a,b)›], OF ‹(a, b) ∈ D›],
        auto simp: φProd_expn' φProd_expn'') .

lemma φelim_ToA_Mapper_template:
  ‹ (⋀x. (x ⦂ U ) = (ψ  x ⦂ S ))
⟹ (⋀x. (x ⦂ U') = (ψ' x ⦂ S'))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀x∈h `D. ψ (φ x) = x)
⟹ 𝗆𝖺𝗉 ψ' o g o φ : S ↦ S' 𝗈𝗏𝖾𝗋 f : T ↦ T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 D
⟹ 𝗆𝖺𝗉 g : U ↦ U' 𝗈𝗏𝖾𝗋 f : T ↦ T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 φ o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o ψ' 𝗂𝗇 D ›
  unfolding ToA_Mapper_def Premise_def
  by clarsimp

lemma φelim_ToA_Mapper_template_SE:
  ‹ (⋀x. (x ⦂ U ) = (ψ  x ⦂ S ))
⟹ (⋀x. (x ⦂ U') = (ψ' x ⦂ S'))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀x∈fst ` h `D. ψ (φ x) = x)
⟹ 𝗆𝖺𝗉 (ψ' o g o φ) ⊗f r : S ✼ R ↦ S' ✼ R' 𝗈𝗏𝖾𝗋 f : T ↦ T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 D
⟹ 𝗆𝖺𝗉 g ⊗f r : U ✼ R ↦ U' ✼ R' 𝗈𝗏𝖾𝗋 f : T ↦ T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 apfst φ o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o apfst ψ' 𝗂𝗇 D ›
  unfolding ToA_Mapper_rev_def Premise_def φProd'_def
  apply (clarsimp simp: φProd_expn' φProd_expn'' ball_conj_distrib[symmetric])
  subgoal premises prems for x
    by (insert prems(1,2,5) prems(3,4)[THEN bspec[where x=‹x›], OF ‹x ∈ D›],
        auto simp: φProd_expn' φProd_expn'' prod.map_beta) .




subparagraph ‹OPEN and MAKE›

text ‹No ‹Object_Equiv› is used and we use ‹(=)› directly because we are destructing or constructing
  a φ-type abstraction by its definition where the definition covers every cases covered by the
  ‹Object_Equiv›, so there is no need to apply ‹Object_Equiv› any more.›

lemma φopen_abstraction_infer:
  ‹ (x ⦂ T) = R
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x' = x
⟹ x' ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R @tag OPEN var 𝒯𝒫 ›
  unfolding Action_Tag_def Simplify_def 𝗋Guard_def Premise_def
  by simp

lemma φopen_abstraction_specified:
  ‹ (x ⦂ T) = R
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x' = x
⟹ x' ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R @tag OPEN i 𝒯𝒫 ›
  unfolding Action_Tag_def Simplify_def 𝗋Guard_def Premise_def
  by simp

lemma φopen_abstraction_ty:
  ‹ (x ⦂ T) = (y ⦂ U)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x' = x
⟹ x' ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U @tag OPEN i 𝒯𝒫' ›
  unfolding Action_Tag_def Simplify_def 𝗋Guard_def Premise_def
  by simp

lemma φmake_abstraction_infer:
  ‹ (x ⦂ T) = U
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = x'
⟹ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x' ⦂ T @tag MAKE var 𝒯𝒫 ›
  unfolding Object_Equiv_def Premise_def Transformation_def 𝗋Guard_def Ant_Seq_def
            Orelse_shortcut_def Action_Tag_def
  by clarsimp

lemma φmake_abstraction_specified:
  ‹ (x ⦂ T) = U
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = x'
⟹ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x' ⦂ T @tag MAKE i 𝒯𝒫 ›
  unfolding Object_Equiv_def Premise_def Transformation_def 𝗋Guard_def Ant_Seq_def
            Orelse_shortcut_def Action_Tag_def
  by clarsimp


lemma φmake_abstraction_ty:
  ‹ (x ⦂ T) = (y ⦂ U)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 y' = y
⟹ y' ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T @tag MAKE i 𝒯𝒫' ›
  unfolding Action_Tag_def Premise_def
  by simp


(*
lemma φmake_Identity_ElementE:
  ‹ (x ⦂ T) = U
⟹ Identity_ElementE U
⟹ Identity_ElementE (x ⦂ MAKE T) ›
  unfolding MAKE_def
  by simp
*)

lemma φgen_expansion:
  ‹ (x ⦂ T) = U
⟹ p ⊨ (x ⦂ T) ≡ p ⊨ U ›
  by simp

lemma φunfold_val:
  ‹ (x ⦂ T) = (y ⦂ U)
⟹ (x ⦂ 𝗏𝖺𝗅[v] T) = (y ⦂ 𝗏𝖺𝗅[v] U) ›
  unfolding Val_def BI_eq_iff φType_def
  by auto

φreasoner_group all_derived_rules = (100, [0,999999]) ‹A group collecting all derived rules›

ML_file ‹library/phi_type_algebra/typ_def.ML›

(*TODO: move*)

consts under_φderiving :: mode

φreasoner_ML under_φderiving %cutting (‹True @tag under_φderiving›) = ‹
  fn (_, (ctxt,sequent)) => Seq.make (fn () =>
      if Config.get ctxt Phi_Type.under_deriving_ctxt
      then SOME ((ctxt, @{lemma' ‹True @tag under_φderiving›
                             by (simp add: Action_Tag_def)} RS sequent), Seq.empty)
      else NONE)  
›

φreasoner_ML ‹Premise under_φderiving› %cutting (‹𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] _›) = ‹
  fn (_, (ctxt, sequent)) => Seq.make (fn () =>
      if Config.get ctxt Phi_Type.under_deriving_ctxt
      then SOME ((ctxt, @{lemma' ‹𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P›
                             by (simp add: Premise_def)} RS sequent), Seq.empty)
      else SOME ((ctxt, @{lemma' ‹𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P›
                             by (simp add: Premise_def)} RS sequent), Seq.empty))
›

lemma [φreason %extract_pure]:
  ‹ 𝗋EIF (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P) P ›
  unfolding 𝗋EIF_def Premise_def
  by blast

lemma [φreason %extract_pure]:
  ‹ 𝗋ESC P (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P) ›
  unfolding 𝗋ESC_def Premise_def
  by blast


hide_fact φintro_transformation φintro_reasoning_transformation φintro'_reasoning_transformation
          φintro'_reasoning_transformation_ty φelim_transformation φelim_reasoning_transformation
          φelim'SEi_transformation φintro_ToA_Mapper_template 


subsection ‹Instances for Predefined Basic φ-Types›

text ‹The section manually gives property instances of predefined basic φ-types and any later φ-types
      are defined using φ-type definition tools and their property instances are derived by derivers.

  Though the property instances of the basic φ-types are given manually here, it does not mean they
  are primitive and cannot be derived automatically. It is just engineeringly, the types are bootstraps
  given very early in the initiation process of the system, so have no chance to enjoy the automation of
  deriver tools and because some properties of them are given manually early, the remaining properties
  also cannot be configured using the deriver tool otherwise clashes happen.
›



section ‹Applications of the Algebraic Properties in Reasoning›

subsection ‹Vary Type Operator among Instantiations›

definition Type_Variant_of_the_Same_Type_Operator
        :: ‹ ('a ⇒ ('b,'c) φ) ⇒ ('a2 ⇒ ('b2,'c2) φ) ⇒ bool ›
  where ‹ Type_Variant_of_the_Same_Type_Operator Fa Fb ⟷ True ›
  ― ‹Fa and Fb are the same functor having identical parameters but of different type instantiations.
      We use this to simulate the Λ operator in system-F›

definition Type_Variant_of_the_Same_Type_Operator2
        :: ‹ ('s ⇒ 'a ⇒ ('b,'c) φ) ⇒ ('s2 ⇒ 'a2 ⇒ ('b2,'c2) φ) ⇒ bool ›
  where ‹ Type_Variant_of_the_Same_Type_Operator2 Fa Fb ⟷ True ›
  ― ‹While ‹Type_Variant_of_the_Same_Type_Operator› considers the φ-type as a type operator
      over each of its parameters, e.g., ‹λA. F A B C› ‹λB. F A B C› ‹λC. F A B C› for ‹F A B C›,
      the ‹Type_Variant_of_the_Same_Type_Operator2› only considers the given φ-type as a binary type
      operator over its last two parameters, e.g., only ‹λB C. F A B C›.
     This is for performance. For other interpretations, user may provide the rule of
      ‹Type_Variant_of_the_Same_Type_Operator2› manually.›

definition Type_Variant_of_the_Same_Scalar_Mul0
        :: ‹ ('s ⇒ ('b,'c) φ) ⇒ ('s2 ⇒ ('b2,'c2) φ) ⇒ bool ›
  where ‹ Type_Variant_of_the_Same_Scalar_Mul0 Fa Fb ⟷ True ›

definition Type_Variant_of_the_Same_Scalar_Mul
        :: ‹ ('s ⇒ 'a ⇒ ('b,'c) φ) ⇒ ('s2 ⇒ 'a2 ⇒ ('b2,'c2) φ) ⇒ bool ›
  where ‹ Type_Variant_of_the_Same_Scalar_Mul Fa Fb ⟷ True ›

definition Parameter_Variant_of_the_Same_Type :: ‹ 'a ⇒ 'b ⇒ bool ›
  where ‹ Parameter_Variant_of_the_Same_Type Fa Fb ⟷ True ›
  ― ‹Every parameter together with any types is differentiated›

definition Parameter_Variant_of_the_Same_TypOpr
        :: ‹ ('p ⇒ ('a,'b) φ) ⇒ ('p2 ⇒ ('c,'d) φ) ⇒ bool ›
  where ‹ Parameter_Variant_of_the_Same_TypOpr Fa Fb ⟷ True ›
  ― ‹Every parameter together with any types is differentiated›

declare [[
  φreason_default_pattern
      ‹Type_Variant_of_the_Same_Type_Operator ?Fa ?Fb› ⇒
      ‹Type_Variant_of_the_Same_Type_Operator ?Fa _›
      ‹Type_Variant_of_the_Same_Type_Operator _ ?Fb›    (100)
  and ‹Type_Variant_of_the_Same_Type_Operator2 ?Fa ?Fb› ⇒
      ‹Type_Variant_of_the_Same_Type_Operator2 ?Fa _›
      ‹Type_Variant_of_the_Same_Type_Operator2 _ ?Fb›   (100)
  and ‹Type_Variant_of_the_Same_Scalar_Mul ?Fa ?Fb› ⇒
      ‹Type_Variant_of_the_Same_Scalar_Mul ?Fa _›
      ‹Type_Variant_of_the_Same_Scalar_Mul _ ?Fb›       (100)
  and ‹Type_Variant_of_the_Same_Scalar_Mul0 ?Fa ?Fb› ⇒
      ‹Type_Variant_of_the_Same_Scalar_Mul0 ?Fa _›
      ‹Type_Variant_of_the_Same_Scalar_Mul0 _ ?Fb›      (100)
  and ‹Parameter_Variant_of_the_Same_Type ?Fa ?Fb› ⇒
      ‹Parameter_Variant_of_the_Same_Type ?Fa _›
      ‹Parameter_Variant_of_the_Same_Type _ ?Fb›        (100)
  and ‹Parameter_Variant_of_the_Same_TypOpr ?Fa ?Fb› ⇒
      ‹Parameter_Variant_of_the_Same_TypOpr ?Fa _›
      ‹Parameter_Variant_of_the_Same_TypOpr _ ?Fb›        (100)
  (*and ‹Parameter_Variant_of_the_Same_Type1 ?Fa _› ⇒ ‹Parameter_Variant_of_the_Same_Type1 ?Fa _› (100)*)
  
  (* φpremise_attribute? [φreason add] for ‹Type_Variant_of_the_Same_Type_Operator _ _› *)
  (* φpremise_attribute? [φreason add] for ‹Parameter_Variant_of_the_Same_Type _ _› *)
]]

φreasoner_group variants_of_type_opr = (%cutting, [%cutting, %cutting])
    for (‹Type_Variant_of_the_Same_Type_Operator F F'›,
         ‹Type_Variant_of_the_Same_Type_Operator2 F F'›,
         ‹Type_Variant_of_the_Same_Scalar_Mul0 F F'›,
         ‹Type_Variant_of_the_Same_Scalar_Mul F F'›,
         ‹Parameter_Variant_of_the_Same_Type F F'›)
    ‹variants_of_type_opr›
  and variants_of_type_opr_overrided = (%cutting+10, [%cutting+10, %cutting+10]) > variants_of_type_opr ‹›

(*
lemma Parameter_Variant_of_the_Same_Type_I [φreason 1]:
  ‹Parameter_Variant_of_the_Same_Type Fa Fb›
  unfolding Parameter_Variant_of_the_Same_Type_def .. *)

lemma Type_Variant_of_the_Same_Type_Operator_I:
  ‹Type_Variant_of_the_Same_Type_Operator Fa Fb›
  unfolding Type_Variant_of_the_Same_Type_Operator_def ..

lemma Type_Variant_of_the_Same_Type_Operator2_I:
  ‹Type_Variant_of_the_Same_Type_Operator2 Fa Fb›
  unfolding Type_Variant_of_the_Same_Type_Operator2_def ..

lemma Type_Variant_of_the_Same_Scalar_Mul_I:
  ‹Type_Variant_of_the_Same_Scalar_Mul Fa Fb›
  unfolding Type_Variant_of_the_Same_Scalar_Mul_def ..

lemma Type_Variant_of_the_Same_Scalar_Mul0_I:
  ‹Type_Variant_of_the_Same_Scalar_Mul0 Fa Fb›
  unfolding Type_Variant_of_the_Same_Scalar_Mul0_def ..

lemma Type_Variant_of_the_Same_Scalar_Mul0_I':
  ‹ Type_Variant_of_the_Same_Scalar_Mul0 (λs. Fa s T) (λs. Fb s U) ›
  unfolding Type_Variant_of_the_Same_Scalar_Mul0_def ..

                    
ML_file ‹library/phi_type_algebra/variant_phi_type_instantiations.ML›

setup ‹
   PLPR_Template_Properties.add_property_kinds [
    pattern_prop‹Type_Variant_of_the_Same_Type_Operator _ _›,
    pattern_prop‹Type_Variant_of_the_Same_Type_Operator2 _ _›,
    pattern_prop‹Type_Variant_of_the_Same_Scalar_Mul _ _›,
    pattern_prop‹Type_Variant_of_the_Same_Scalar_Mul0 _ _›,
    pattern_prop‹Parameter_Variant_of_the_Same_Type _ _›,
    pattern_prop‹Parameter_Variant_of_the_Same_TypOpr _ _›
  (*pattern_prop‹Parameter_Variant_of_the_Same_Type1 _ _›*)
  ]
›

φreasoner_ML Parameter_Variant_of_the_Same_Type %variants_of_type_opr_overrided (‹Parameter_Variant_of_the_Same_Type _ ?var›) = ‹
  fn (_, (ctxt, sequent)) => Seq.make (fn () =>
    let val (bvtys, goal) = Phi_Help.strip_meta_hhf_bvtys (Phi_Help.leading_antecedent' sequent)
        val _ (*Trueprop*) $ (_ (*Parameter_Variant_of_the_Same_Type*) $ LHS $ var) = goal
        val thy = Proof_Context.theory_of ctxt
        val (Var (v, _), bargs) = strip_comb var
        val barg_tys = map (fn x => fastype_of1 (bvtys, x)) bargs
        exception Not_A_Phi_Type
        fun parse lv bvs (X $ Bound i) =
              if i < lv then parse lv (SOME i :: bvs) X else parse lv (NONE :: bvs) X
          | parse lv bvs (X $ Y) = parse lv (NONE :: bvs) X
          | parse lv bvs (Abs(_,_,X)) = parse (lv+1) (map (Option.map (fn i=>i+1)) bvs) X
          | parse lv bvs (Const(N, _)) =
              let val idx = Thm.maxidx_of sequent + 1
                  val ty = Logic.incr_tvar idx (Sign.the_const_type thy N )
                  val args = List.take (Term.binder_types ty, length bvs)
                  val a_num = length args
                  val b_num = length barg_tys
                  val parameterize = fold_index (fn (i,_) => fn X => X $ Bound (a_num+b_num-1-i)) barg_tys
                  val const = Const(N, ty)
                  val (F0,bvs) = fold_index (
                        fn (_, (SOME b, ty)) => (fn (X,bvs) => (X $ Bound b, (b,ty)::bvs))
                         | (i, (NONE, ty)) => (fn (X,bvs) => (X $ parameterize (Var (("x",idx+i), barg_tys ---> ty)), bvs))
                      ) (bvs ~~ args) (const, [])
                  val F = fold_index (fn (i,_) => fn X =>
                            case AList.lookup (op =) bvs i
                              of SOME ty => Abs ("_", ty, X)
                               | NONE => raise Not_A_Phi_Type
                          ) bvs F0
                       |> fold_rev (fn ty => fn X => Abs ("_", ty, X)) barg_tys
                       |> Thm.cterm_of ctxt
               in Drule.infer_instantiate ctxt [(v, F)] sequent
               |> (fn th => @{lemma' ‹Parameter_Variant_of_the_Same_Type A B›
                                  by (simp add: Parameter_Variant_of_the_Same_Type_def)} RS th)
               |> (fn th => SOME ((ctxt,th), Seq.empty))
              end
     in parse 0 [] LHS
    end
) ›


subsection ‹Auxiliary›

definition SE_Has_or_Not
  where ‹SE_Has_or_Not C W F FW ⟷ (if C then FW = F W else W = ○ ∧ FW = ○)›

definition SE_Has_or_Not2
  where ‹SE_Has_or_Not2 C W1 W2 F FW ⟷ (if C then FW = F W1 W2 else W1 = ○ ∧ W2 = ○ ∧ FW = ○)›

definition SE_Has_or_NotΛ
  where ‹SE_Has_or_NotΛ C W F FW ⟷ (if C then FW = F W else (∀a. W a = ○) ∧ FW = ○)›

φreasoner_group 
        SE_Has_or_Not_all = (100, [10,2000]) ‹›
    and SE_Has_or_Not = (1000, [1000,1030]) in SE_Has_or_Not_all ‹›
    and SE_Has_or_Not_default = (30, [10,50]) in SE_Has_or_Not_all ‹›

declare [[ φreason_default_pattern
      ‹SE_Has_or_Not _ ?W ?F _› ⇒ ‹SE_Has_or_Not _ ?W ?F _› (100)
  and ‹SE_Has_or_NotΛ _ ?W ?F _› ⇒ ‹SE_Has_or_NotΛ _ ?W ?F _› (100)
  and ‹SE_Has_or_Not2 _ ?W1 ?W2 ?F _› ⇒ ‹SE_Has_or_Not2 _ ?W1 ?W2 ?F _› (100)
]]

lemma SE_Has_or_Not_alt_def:
  ‹ SE_Has_or_Not C W F FW ⟷ ◒[C] W = W ∧ ◒[C] F W = FW ›
  unfolding SE_Has_or_Not_def
  by simp blast

lemma SE_Has_or_Not2_alt_def:
  ‹ SE_Has_or_Not2 C W1 W2 F FW ⟷ ◒[C] W1 = W1 ∧ ◒[C] W2 = W2 ∧ ◒[C] F W1 W2 = FW ›
  unfolding SE_Has_or_Not2_def
  by simp blast

lemma SE_Has_or_NotΛ_alt_def:
  ‹ SE_Has_or_NotΛ C W F FW ⟷ (∀a. ◒[C] W a = W a) ∧ ◒[C] F W = FW ›
  unfolding SE_Has_or_NotΛ_def
  by simp fastforce

lemma SE_Has_or_Not_None[φreason %SE_Has_or_Not + 10]:
  ‹ SE_Has_or_Not False ○ F ○ ›
  unfolding SE_Has_or_Not_def
  by (simp add: φNone_def)

lemma SE_Has_or_NotΛ_None[φreason %SE_Has_or_Not + 10]:
  ‹ SE_Has_or_NotΛ False (λ_. ○) F ○ ›
  unfolding SE_Has_or_NotΛ_def
  by (simp add: φNone_def)

lemma SE_Has_or_Not2_None[φreason %SE_Has_or_Not + 10]:
  ‹ SE_Has_or_Not2 False ○ ○ F ○ ›
  unfolding SE_Has_or_Not2_def
  by (simp add: φNone_def)


lemma [φreason %SE_Has_or_Not]:
  ‹ SE_Has_or_Not True W F (F W) ›
  unfolding SE_Has_or_Not_def
  by simp

lemma [φreason %SE_Has_or_Not]:
  ‹ SE_Has_or_Not2 True W1 W2 F (F W1 W2) ›
  unfolding SE_Has_or_Not2_def
  by simp

lemma [φreason %SE_Has_or_Not]:
  ‹ SE_Has_or_NotΛ True W F (F W) ›
  unfolding SE_Has_or_NotΛ_def
  by simp

lemma [φreason default %SE_Has_or_Not_default]:
  ‹ SE_Has_or_Not C F W FW
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 FW = FW'
⟹ SE_Has_or_Not C F W FW' ›
  unfolding Premise_def
  by simp

lemma [φreason default %SE_Has_or_Not_default]:
  ‹ SE_Has_or_Not2 C F W1 W2 FW
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 FW = FW'
⟹ SE_Has_or_Not2 C F W1 W2 FW' ›
  unfolding Premise_def
  by simp
  
lemma [φreason default %SE_Has_or_Not_default]:
  ‹ SE_Has_or_NotΛ C F W FW
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 FW = FW'
⟹ SE_Has_or_NotΛ C F W FW' ›
  unfolding Premise_def
  by simp


subsection ‹Transformation Functor›

lemma [φreason_template name Fa.simp_cong [φsimp_cong]]:
  ‹ Transformation_Functor Fa Fa T U (λx. {x}) (λx. ⊤) (λx. x)
⟹ Transformation_Functor Fa Fa U T (λx. {x}) (λx. ⊤) (λx. x)
⟹ PROP NO_SIMP' ((x ⦂ T) ≡ (x' ⦂ U))
⟹ (x ⦂ Fa T) ≡ (x' ⦂ Fa U)›
  unfolding Transformation_Functor_def Transformation_def atomize_eq NO_SIMP'_def
  apply (auto simp add: BI_eq_iff)
  subgoal premises prems for xa
    using prems(1)[THEN spec[where x=x], THEN spec[where x=‹λ_ c. c = x'›], simplified]
    using prems(3) prems(4) by blast
  subgoal premises prems for xa
    using prems(2)[THEN spec[where x=x'], THEN spec[where x=‹λ_ c. c = x›], simplified]
    using prems(3) prems(4) by blast
  .


lemma transformation[φreason_template name Fa.transformation []]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
⟹ (⋀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y ›
  unfolding meta_Ball_def Premise_def 𝗋Guard_def Transformation_Functor_def Action_Tag_def
  by clarsimp

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.To_Transformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
⟹ (⋀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b @tag to Z)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (Fb Z) ›
  unfolding Action_Tag_def 𝗋Guard_def
  using transformation[unfolded 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor_fuzzy name Fa.To_Transformation_fuzzy]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 NO_MATCH TYPE('caa) TYPE('c))
⟹ 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
⟹ (⋀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b @tag to Z)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to Z
    <except-pattern> (XX::'caa BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YY 𝗐𝗂𝗍𝗁 PP @tag to Z ›
  for Fa :: ‹('ca, 'aa) φ ⇒ ('c,'a) φ› and Z :: ‹('caa, 'aaa) φ›
  unfolding Action_Tag_def 𝗋Guard_def Except_Pattern_def
  using transformation[unfolded 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.to_traverse]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
⟹ (⋀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z) ›
  unfolding Action_Tag_def 𝗋Guard_def
  using transformation[unfolded 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜simp [φtransformation_based_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D x. (a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b @tag 𝒜simp))
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformation[unfolded atomize_Ball Premise_def 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜backward_simp [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D x. (a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b @tag 𝒜backward_simp))
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_backward_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformation[unfolded atomize_Ball Premise_def 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor Fa Fb T U D R pred_mapper func_mapper
⟹ (⋀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a ⦂ U 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫 )
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a. a ∈ D x ⟶ f a ∈ R x) 
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x ⦂ Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x @tag 𝒯𝒫 ›
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_Transformation_Functor[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .


subsection ‹Bi-Transformation Functor›

lemma bitransformation[φreason_template name Fa.bitransformation []]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b)
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2  𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y›
  unfolding meta_Ball_def Premise_def 𝗋Guard_def Transformation_BiFunctor_def
            Transformation_def
  by clarsimp

(*
lemma CV_bitransformation[φreason_template name Fa.bitransformation []]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∃b. g1 a b ∧ b ∈ D1 x) ⟹ a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 a b)
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. b ∈ D1 x ∧ g1 a b ⟶ a ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2  𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y›
  unfolding meta_Ball_def Premise_def 𝗋Guard_def CV_TrFunctor_def Transformation_def
  by clarsimp
*)

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.To_BiTransformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag to Z1)
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag to Z2)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag to (Fb Z1 Z2) ›
  unfolding Action_Tag_def 𝗋Guard_def
  using bitransformation[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.to_bitraverse]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z1))
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z2))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Fb Z1 Z2) ›
  unfolding Action_Tag_def 𝗋Guard_def
  using bitransformation[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .

lemma [φreason_template name Fa.𝒜simp_bi [φtransformation_based_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D1 x. (a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag 𝒜try_simp M1))
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D2 x. (a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag 𝒜try_simp M2))
⟹ 𝗀𝗎𝖺𝗋𝖽 M1 ∨ M2
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag 𝒜_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using bitransformation[unfolded atomize_Ball 𝗋Guard_def Premise_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .


lemma [φreason_template name Fa.𝒜backward_simp_bi [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D1 x. (a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag 𝒜try_backward_simp M1))
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D2 x. (a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag 𝒜try_backward_simp M2))
⟹ 𝗀𝗎𝖺𝗋𝖽 M1 ∨ M2
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag 𝒜_backward_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using bitransformation[unfolded atomize_Ball 𝗋Guard_def Premise_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .


lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pred_mapper func_mapper
⟹ (⋀a ∈ D1 x. a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ U1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫 )
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫 )
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a. a ∈ D1 x ⟶ f1 a ∈ R1 x) ∧ (∀a. a ∈ D2 x ⟶ f2 a ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x ⦂ Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x @tag 𝒯𝒫 ›
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_Transformation_BiFunctor[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .

(*
lemma [φreason_template name Fa.𝒜backward_simp_bi [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∃b. g1 a b ∧ b ∈ D1 x)
            ⟶ (a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 a b @tag 𝒜backward_simp))
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D2 x. (a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag 𝒜backward_simp))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. b ∈ D1 x ∧ g1 a b ⟶ a ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag 𝒜_backward_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def atomize_imp
  using CV_bitransformation[unfolded atomize_Ball atomize_imp atomize_all 𝗋Guard_def Premise_def,
            where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and R1=R1 and R2=R2 and mapper=mapper] .
*)

lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pred_mapper func_mapper
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 f1 a ∈ D1 x ⟹ a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ T1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫 )
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫 )
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 FC1 f1 x ∧ (∀a. a ∈ D2 x ⟶ f2 a ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x ⦂ Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x @tag 𝒯𝒫 ›
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_CV_BiFunctor[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .


subsection ‹Transformation Functor with Parameterization›

lemma transformationΛ[φreason_template name Fa.transformation []]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ (⋀p. ⋀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y›
  unfolding meta_Ball_def Premise_def 𝗋Guard_def Transformation_FunctorΛ_def
  by clarsimp

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.To_Transformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ (⋀p. ⋀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to (Z p))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (Fb Z) ›
  unfolding Action_Tag_def 𝗋Guard_def
  using transformationΛ[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor_fuzzy name Fa.To_Transformation_fuzzy]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 NO_MATCH TYPE('caa) TYPE('c))
⟹ 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ (⋀p. ⋀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to Z)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to Z
    <except-pattern> (XX::'caa BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YY 𝗐𝗂𝗍𝗁 PP @tag to Z ›
  for Fa :: ‹('p ⇒ ('ca, 'aa) φ) ⇒ ('c,'a) φ› and Z :: ‹('caa, 'aaa) φ›
  unfolding Action_Tag_def 𝗋Guard_def Except_Pattern_def
  using transformationΛ[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.to_traverse]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ (⋀p. ⋀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z) ›
  unfolding Action_Tag_def 𝗋Guard_def
  using transformationΛ[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜simp [φtransformation_based_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀p. ∀a ∈ D p x. (a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b @tag 𝒜simp))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformationΛ[unfolded atomize_Ball atomize_all Premise_def 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜backward_simp [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀p. ∀a ∈ D p x. (a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b @tag 𝒜backward_simp))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x)
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_backward_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformationΛ[unfolded atomize_Ball atomize_all Premise_def 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_FunctorΛ Fa Fb T U D R pred_mapper func_mapper
⟹ (⋀p. ⋀a ∈ D p x. a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a ⦂ U p 𝗐𝗂𝗍𝗁 P p a @tag 𝒯𝒫 )
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀p a. a ∈ D p x ⟶ f p a ∈ R p x) 
⟹ x ⦂ Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x ⦂ Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x @tag 𝒯𝒫 ›
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_Transformation_FunctorΛ[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .



subsection ‹Separation Homomorphism›

lemma Object_Sep_HomoI_subdom[
        φadding_property = false,
        φreason %φTA_varify_out except ‹Object_Sep_HomoI _ ?var›,
        φadding_property = true
      ]:
  ‹ Object_Sep_HomoI T Da
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Db ⊆ Da
⟹ Object_Sep_HomoI T Db›
  unfolding Object_Sep_HomoI_def Premise_def subset_iff
  by blast

lemma [φreason_template default %φsimp_derived_Tr_functor+5 name Fb.𝒜simp_sep_homo]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE FaL FaR Fb UL UR Du un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Du
⟹ x ⦂ Fb (UL ∗𝒜 UR) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ FaL UL ∗𝒜 FaR UR 𝗌𝗎𝖻𝗃 y. y = un x @tag 𝒜simp›
  unfolding Separation_HomoE_def Action_Tag_def Bubbling_def 𝗋Guard_def Premise_def
  by (clarsimp simp: Subjection_transformation_rewr Ex_transformation_expn)

(*Object_Sep_HomoI is necessary at least for composition φ-type
Object_Sep_HomoI B ⟷ Separation_HomoI ((⨾) B) ((⨾) B) ((⨾) B) (λx. x)
*)

(*There are two inner element ‹a,b›, we construct an inner transformation from ‹(a ⦂ T) * (b ⦂ T)›
    to ‹(b * a) ⦂ T›
  Note here ‹c = b * a› only if the ‹*› is defined between b and a.
*)

lemma Separation_Homo_functor[φreason_template default %Object_Sep_Homo_functor]:
  ‹ Separation_HomoI F F F' T T Ds zz
⟹ Transformation_Functor F' F (T ∗ T) T D R m
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x y z. m (λ(a, b) c. c = a * b ∧ a ## b ∧ (a, b) ∈ D (zz (x, y))) (zz (x, y)) z
                        ⟶ z = x * y ∧ x ## y) ∧
           (∀x y a b. (a, b) ∈ D (zz (x, y)) ⟶ a * b ∈ R (zz (x, y)))
⟹ Object_Sep_HomoI T (Set.bind Ds (D o zz))
⟹ Object_Sep_HomoI (F T) Ds›
  unfolding Object_Sep_HomoI_def Transformation_Functor_def Separation_HomoI_def Premise_def
            meta_Ball_def meta_case_prod_def split_paired_all
  apply (simp (no_asm_use) add: φProd_expn'[symmetric] del: split_paired_All; clarify)
  subgoal premises prems for x y
  proof -
    have t1: ‹∀a∈D (zz (x, y)). a ⦂ T ∗ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T 𝗌𝗎𝖻𝗃 b. (case a of (a, b) ⇒ λc. c = a * b ∧ a ## b ∧ (a, b) ∈ D (zz (x, y))) b›
      by (clarsimp, insert prems(3,6), blast)
    from prems(2)[THEN spec[where x=‹zz (x,y)›],
                  THEN spec[where x=‹λ(a,b) c. c = a * b ∧ a ## b ∧ (a,b) ∈ D (zz (x,y))›],
                  THEN mp, OF t1]
         prems(4)[THEN spec[where x=x], THEN spec[where x=y]]
         prems(1,5,6)
    show ?thesis
      by (clarsimp simp add: Transformation_def, blast)
  qed .

lemma [φreason_template name Fc.φProd_ty []]:
  ‹ Separation_HomoI Ft Fu Fc T U UNIV (λx. x)
⟹ Separation_HomoE Ft Fu Fc T U UNIV (λx. x)
⟹ Fc (T ∗ U) = Ft T ∗ Fu U ›
  unfolding Separation_HomoI_def Separation_HomoE_def
  by (rule φType_eqI_Tr ; simp add: split_paired_all)

lemma [φreason_template name FTU.φProd[]]:
  ‹ Separation_HomoI FT FU FTU T U Dz f
⟹ Separation_HomoE FT FU FTU T U Du g
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 g (f x) = x ∧ x ∈ Dz ∧ f x ∈ Du
⟹ (x ⦂ FT T ∗ FU U) = (f x ⦂ FTU (T ∗ U))›
  unfolding Separation_HomoE_def Separation_HomoI_def Premise_def Transformation_def
            BI_eq_iff
  by (clarsimp; metis prod.collapse)

(*TODO: a deriver controlling the form of ‹Separation_HomoI_Cond›
Here we give a quick but imperfect deriving without such control
note, also refer to the git branch Separation_HomoΛI_Cond
*)


lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoI_Cond]:
  ‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CW ⟹ Separation_HomoI Ft Fu F3 T U D z)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CW ⟹ Functional_Transformation_Functor Ft F3 T (T ∗ ◒[CW] U) D' R' pred' func' )
⟹ Separation_HomoI_Cond Ft Fu F3 CW T U (?ZD[CW] D D' R') (?Z[CW] z (λf. func' f (λ_. True))) ›
  unfolding Separation_HomoI_Cond_def Separation_HomoI_def Premise_def Action_Tag_def Simplify_def
            LPR_ctrl_def
  by ((cases CW; clarsimp),
       insert apply_Functional_Transformation_Functor
              [unfolded Argument_def Premise_def,
                where Fa=Ft and Fb=F3 and func_mapper=func' and f=‹(λx. (x, unspec))› and
                      pred_mapper=pred' and P=‹λ_. True› and T=‹T› and U=‹T ∗ ◒[CW] U› and
                      D=D' and R=R'],
       clarsimp simp: φProd_expn', insert transformation_weaken, blast)


lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoE_Cond]:
  ‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CR ⟹ Separation_HomoE Ft Fu F3 T U Du uz)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CR ⟹ Functional_Transformation_Functor F3 Ft (T ∗ ◒[CR] U) T Dz R' pred' func' )
⟹ Separation_HomoE_Cond Ft Fu F3 CR T U (?UZD[CR] Du Dz R') (?UZ[CR] uz (λf. func' f (λ_. True))) ›
  unfolding Separation_HomoE_Cond_def Separation_HomoE_def Premise_def Action_Tag_def Simplify_def
  by ((cases CR; clarsimp),
      insert apply_Functional_Transformation_Functor[unfolded Argument_def Premise_def,
                  where Fa=F3 and Fb=Ft and func_mapper=func' and f=‹fst› and
                        pred_mapper=pred' and P=‹λ_. True› and U=‹T› and T=‹T ∗ ◒[CR] U› and
                        D=Dz and R=R'];
      clarsimp simp: φProd_expn' φProd_expn'',
      metis case_prod_conv transformation_weaken)



subsubsection ‹With Parameterization›

lemma [φreason_template default %φsimp_derived_Tr_functor+5 name Fb.𝒜simp_sep_homo]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoΛE FaL FaR Fb UL UR Du un
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Du
⟹ x ⦂ Fb (λp. UL p ∗𝒜 UR p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ FaL UL ∗𝒜 FaR UR 𝗌𝗎𝖻𝗃 y. y = un x @tag 𝒜simp›
  unfolding Separation_HomoΛE_def Action_Tag_def Bubbling_def 𝗋Guard_def Premise_def
  by (clarsimp simp: Subjection_transformation_rewr Ex_transformation_expn)

lemma [φreason_template name Fc.φProd_ty []]:
  ‹ Separation_HomoΛI Ft Fu Fc T U UNIV (λx. x)
⟹ Separation_HomoΛE Ft Fu Fc T U UNIV (λx. x)
⟹ Fc (λp. T p ∗ U p) = Ft T ∗ Fu U ›
  unfolding Separation_HomoΛI_def Separation_HomoΛE_def
  by (rule φType_eqI_Tr ; simp add: split_paired_all)

lemma [φreason_template name FTU.φProd[]]:
  ‹ Separation_HomoΛI FT FU FTU T U Dz f
⟹ Separation_HomoΛE FT FU FTU T U Du g
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Dz ∧ g (f x) = x ∧ f x ∈ Du
⟹ (x ⦂ FT T ∗ FU U) = (f x ⦂ FTU (λp. T p ∗ U p))›
  unfolding Separation_HomoΛE_def Separation_HomoΛI_def Premise_def
            Transformation_def BI_eq_iff
  by (clarsimp; metis (no_types, lifting) prod.collapse)


lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoI_Cond]:
  ‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CW ⟹ Separation_HomoΛI Ft Fu F3 T U D z)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CW ⟹ Functional_Transformation_FunctorΛ Ft F3 T (λp. T p ∗ ◒[CW] U p) D' R' pred' func' )
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DD : (if LPR_ctrl CW then D else {x. ∀p a. a ∈ D' p (fst x) ⟶ (a, unspec) ∈ R' p (fst x)})) @tag 𝒜_template_reason undefined
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] ZZ : (if LPR_ctrl CW then z else func' (λ_ x. (x, unspec)) (λ_ _. True) o fst)) @tag 𝒜_template_reason undefined
⟹ Separation_HomoΛI_Cond Ft Fu F3 CW T U DD ZZ ›
  unfolding Separation_HomoΛI_Cond_def Separation_HomoΛI_def Premise_def Action_Tag_def Simplify_def
            LPR_ctrl_def
  by (cases CW; clarsimp;
      insert apply_Functional_Transformation_FunctorΛ
                [unfolded Argument_def Premise_def,
                  where Fa=Ft and Fb=F3 and func_mapper=func' and f=‹λ_ x. (x, unspec)› and
                        pred_mapper=pred' and P=‹λ_ _. True› and T=T and U=‹λp. T p ∗ ◒[CW] U p› and
                        D=D' and R=R'];
      clarsimp simp: φProd_expn';
      insert transformation_weaken; blast)

lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoE_Cond]:
  ‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CR ⟹ Separation_HomoΛE Ft Fu F3 T U Du uz)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CR ⟹ Functional_Transformation_FunctorΛ F3 Ft (λp. T p ∗ ◒[CR] U p) T D' R' pred' func' )
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DD : (if LPR_ctrl CR then Du else {x. ∀p. ∀(a,b) ∈ D' p x. a ∈ R' p x})) @tag 𝒜_template_reason undefined
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] UZ : (if LPR_ctrl CR then uz else (λx. (func' (λ_. fst) (λ_ _. True) x, unspec)))) @tag 𝒜_template_reason undefined
⟹ Separation_HomoΛE_Cond Ft Fu F3 CR T U DD UZ ›
  unfolding Separation_HomoΛE_Cond_def Separation_HomoΛE_def Premise_def Action_Tag_def Simplify_def
  by (cases CR; clarsimp;
      insert apply_Functional_Transformation_FunctorΛ[unfolded Argument_def Premise_def,
                  where Fa=F3 and Fb=Ft and func_mapper=func' and f=‹λ_. fst› and
                        pred_mapper=pred' and P=‹λ_ _. True› and U=T and T=‹λp. T p ∗ ◒[CR] U p› and
                        D=D' and R=R'];
      clarsimp simp: φProd_expn' φProd_expn'';
      metis (no_types, lifting) case_prodD transformation_weaken)



subsection ‹Semimodule›

subsubsection ‹Zero›

lemma [φadding_property = false,
       φreason default %φTA_fallback_lattice,
       φadding_property = true]:
  ‹ Closed_Module_Zero F zero
⟹ Module_Zero F zero ›
  unfolding Closed_Module_Zero_def Module_Zero_def
  by simp

paragraph ‹Equations›

lemma [φreason_template name F.scalar_zero [assertion_simps, simp]]:
  ‹ Closed_Module_Zero F zero
⟹ (x ⦂ F zero) = 1 ›
  unfolding Closed_Module_Zero_def by blast

lemma [φreason_template name F.scalar_zero' [assertion_simps, simp]]:
  ‹ Closed_Module_Zero F zero
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 zero' : zero) @tag 𝒜_template_reason undefined
⟹ NO_MATCH zero zero' @tag 𝒜_template_reason None
⟹ (x ⦂ F zero') = 1 ›
  unfolding Closed_Module_Zero_def Simplify_def Action_Tag_def
  by blast

paragraph ‹Identity Elements›

lemma [φreason_template default %derived_identity_element+5]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Closed_Module_Zero F zero
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 zero' = zero
⟹ Identity_ElementsE (F zero') (λ_. True) ›
  unfolding Identity_ElementsE_def Identity_ElementE_def 𝗋Guard_def
            Transformation_def Premise_def Closed_Module_Zero_def
  by clarsimp

lemma [φreason_template default %derived_identity_element+5]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_Zero F zero
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 zero' = zero
⟹ Identity_ElementsI (F zero') (λ_. True) (λ_. True) ›
  unfolding Identity_ElementsI_def Identity_ElementI_def 𝗋Guard_def
            Transformation_def Premise_def Module_Zero_def
  by clarsimp


paragraph ‹Transformations›

lemma [φreason_template default %ToA_derived_red]:
  ‹ Module_Zero F zero
⟹ NO_SIMP (1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫)
⟹ NO_SIMP (x ⦂ F zero 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫) ›
  unfolding Module_Zero_def NO_SIMP_def Action_Tag_def
  using mk_elim_transformation by blast

lemma [φreason_template default %ToA_derived_red ]:
  ‹ Module_Zero F zero
⟹ NO_SIMP (R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y  @tag 𝒯𝒫)
⟹ NO_SIMP ((x ⦂ F zero) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫) ›
  for R :: ‹'c::sep_magma_1 BI›
  unfolding Module_Zero_def NO_SIMP_def Action_Tag_def
  using transformation_bi_frame
  by fastforce


lemma [φreason_template default %ToA_derived_red]:
  ‹ Module_Zero F zero
⟹ NO_SIMP (apfst (λ_. unspec) x ⦂ ○ ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫')
⟹ NO_SIMP (x ⦂ F zero ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫') ›
  for W :: ‹('c::sep_magma_1, 'x) φ›
  unfolding Module_Zero_def NO_SIMP_def Action_Tag_def φProd'_def
  by (cases x; clarsimp simp: φProd_expn'; insert transformation_bi_frame; fastforce)


lemma [φreason_template default %ToA_derived_red]:
  ‹ Closed_Module_Zero F zero
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ F zero 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ›
  unfolding Closed_Module_Zero_def Identity_ElementI_def NO_SIMP_def
  by simp


lemma [φreason_template default %ToA_derived_red]:
  ‹ Closed_Module_Zero F zero
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ F zero 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ›
  for R :: ‹'c::sep_magma_1 BI›
  unfolding Closed_Module_Zero_def Identity_ElementI_def NO_SIMP_def
  by simp


lemma [φreason_template default %ToA_derived_red]:
  ‹ Closed_Module_Zero F zero
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ ○ ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (any, snd x) ⦂ F zero ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫') ›
  unfolding Closed_Module_Zero_def Identity_ElementI_def NO_SIMP_def φProd'_def
  by (clarsimp simp add: φProd_expn'' φProd_expn')


subsubsection ‹One›

paragraph ‹Rewrites Eliminating Identity Scalar›

lemma [φreason_template name F.scalar_one_ty [assertion_simps, simp]]:
  ‹ Module_OneI F T1 one (λ_. True) (λx. x) PI
⟹ Module_OneE F T1 one (λ_. True) (λx. x) PE
⟹ F one = T1 ›
  unfolding Module_OneI_def Module_OneE_def
  by (rule φType_eqI_Tr; clarsimp simp add: Transformation_def)

lemma [φreason_template name F.scalar_one_ty' [assertion_simps, simp]]:
  ‹ Module_OneI F T1 one (λ_. True) (λx. x) PI
⟹ Module_OneE F T1 one (λ_. True) (λx. x) PE
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
⟹ NO_MATCH one one' @tag 𝒜_template_reason None
⟹ F one' = T1 ›
  unfolding Module_OneI_def Module_OneE_def Simplify_def Action_Tag_def
  by (rule φType_eqI_Tr; clarsimp simp add: Transformation_def)

lemma [φreason_template name F.scalar_one [assertion_simps, simp]]:
  ‹ Module_OneI F T1 one DI f PI
⟹ Module_OneE F T1 one DE g PE
⟹ Object_Equiv (F one) eq @tag 𝒜_template_reason undefined
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x ∧ DI (g x) ∧ eq (f (g x)) x
⟹ (x ⦂ F one) = (g x ⦂ T1) ›
  unfolding Module_OneI_def Module_OneE_def BI_eq_iff Transformation_def Premise_def
            Object_Equiv_def Action_Tag_def
  by (clarsimp; metis)

lemma [φreason_template name F.scalar_one' [assertion_simps, simp]]:
  ‹ Module_OneI F T1 one DI f PI
⟹ Module_OneE F T1 one DE g PE
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
⟹ NO_MATCH one one' @tag 𝒜_template_reason None
⟹ Object_Equiv (F one) eq @tag 𝒜_template_reason undefined
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x ∧ DI (g x) ∧ eq (f (g x)) x
⟹ (x ⦂ F one') = (g x ⦂ T1) ›
  unfolding Module_OneI_def Module_OneE_def BI_eq_iff Transformation_def Premise_def
            Simplify_def Action_Tag_def Object_Equiv_def
  by (clarsimp; metis)


paragraph ‹Protector Preventing Eliminating the just Introduced Scalar Identity›

definition [iff, φsafe_simp]: ‹introduced X ≡ X›

subparagraph ‹arith_eval›


lemma [φreason %𝒜_partial_add_normalizing]:
  ‹ equation31_cond Cd Cc a b ab c X
⟹ equation31_cond Cd Cc a (introduced b) ab c X ›
  by simp

lemma [φreason %𝒜_partial_add_normalizing]:
  ‹ equation31_cond Cd Cc a b ab c X
⟹ equation31_cond Cd Cc a b ab c (introduced X) ›
  by simp


lemma [φreason %partial_add_overlaps_norm]:
  ‹ partial_add_overlaps a b
⟹ partial_add_overlaps (introduced a) b ›
  by simp

lemma [φreason %partial_add_overlaps_norm]:
  ‹ partial_add_overlaps a b
⟹ partial_add_overlaps a (introduced b) ›
  by simp


paragraph ‹ToA Eliminating Identity Scalar›

subparagraph ‹Implementation›

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one DE g PE
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
⟹ 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x
⟹ NO_SIMP (g x ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ x ⦂ F one' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ∧ PE x @tag 𝒯𝒫
      <except-pattern> x ⦂ F (introduced one') 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY 𝗐𝗂𝗍𝗁 PPP @tag 𝒯𝒫 ›
  unfolding Module_OneI_def Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def
            Transformation_def Except_Pattern_def is_id_element_def Simplify_def Action_Tag_def
  by (clarsimp; metis)

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one DE g PE
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
⟹ 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x
⟹ NO_SIMP (R * (g x ⦂ T1) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ R * (x ⦂ F one') 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ∧ PE x @tag 𝒯𝒫
      <except-pattern> RRR * (x ⦂ F (introduced one')) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY 𝗐𝗂𝗍𝗁 PPP @tag 𝒯𝒫 ›
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            Except_Pattern_def is_id_element_def Simplify_def Action_Tag_def
  by (clarsimp; metis)
  ― ‹the rule is invoked only once for each φ-type in the source, so no problem to invoke the
      simple tactic for each time.›

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D g PE
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ NO_SIMP (apfst g x ⦂ T1 ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ x ⦂ F one ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ∧ PE (fst x) @tag 𝒯𝒫' ›
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def Action_Tag_def φProd'_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D g PE
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
⟹ NO_MATCH one one' @tag 𝒜_template_reason None
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ NO_SIMP (apfst g x ⦂ T1 ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ x ⦂ F one' ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ∧ PE (fst x) @tag 𝒯𝒫' ›
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Simplify_def Action_Tag_def Action_Tag_def
            Transformation_def Except_Pattern_def φProd'_def
  by (clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %derived_SE_red_scalar_one]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D g PE
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
⟹ 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ NO_SIMP (apfst g x ⦂ T1 ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ x ⦂ F one' ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ∧ PE (fst x) @tag 𝒯𝒫'
      <except-pattern> x ⦂ F (introduced one') ✼ WWW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY 𝗐𝗂𝗍𝗁 PPP @tag 𝒯𝒫' ›
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            Except_Pattern_def Simplify_def is_id_element_def Action_Tag_def φProd'_def
  by (clarsimp simp add: φProd_expn'; metis)



lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
⟹ 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T1 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F one' 𝗐𝗂𝗍𝗁 P ∧ PI x @tag 𝒯𝒫
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var ⦂ F one' 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫
      <except-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'' ⦂ F (introduced one') 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫 ›
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Except_Pattern_def
            Transformation_def With_Pattern_def Simplify_def is_id_element_def Action_Tag_def
  by (simp; metis)

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
⟹ 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F one' 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P ∧ PI x @tag 𝒯𝒫
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var ⦂ F one' 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫
      <except-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'' ⦂ F (introduced one') 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫 ›
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            With_Pattern_def Except_Pattern_def is_id_element_def Simplify_def Action_Tag_def
  by (clarsimp; metis)

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ NO_MATCH (id one'') one @tag 𝒜_template_reason undefined
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T1 ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x ⦂ F one ✼ R 𝗐𝗂𝗍𝗁 P ∧ PI (fst x) @tag 𝒯𝒫'
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var ⦂ F one ✼ RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            With_Pattern_def Action_Tag_def φProd'_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
⟹ NO_MATCH one one' @tag 𝒜_template_reason None
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T1 ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x ⦂ F one' ✼ R 𝗐𝗂𝗍𝗁 P ∧ PI (fst x) @tag 𝒯𝒫'
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var ⦂ F one' ✼ RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Simplify_def Action_Tag_def
            Transformation_def With_Pattern_def φProd'_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %derived_SE_red_scalar_one]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
⟹ 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T1 ✼ R 𝗐𝗂𝗍𝗁 P) @tag 𝒯𝒫'
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x ⦂ F one' ✼ R 𝗐𝗂𝗍𝗁 P ∧ PI (fst x) @tag 𝒯𝒫'
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var ⦂ F one' ✼ RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
      <except-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'' ⦂ F (introduced one') ✼ RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def φProd'_def
            With_Pattern_def Except_Pattern_def Simplify_def is_id_element_def Action_Tag_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

(*TODO: provide the version for ToA mapper*)


paragraph ‹Reasoning when having SDistr›

text ‹The difficulty of reasoning φ-type transformations lies in the two directions that 
  the transformations can follow, hierarchically swapping an inner φ-type out ‹F (G T) ⟶ G (F T)›
  and horizontally over ‹*› including splitting and merging.

  As an example example, the reasoning of transformation
  ‹x ⦂ F a T * others ⟶ y ⦂ F b U› with ‹a ≤ b› can reduce to 2 subgoals, ‹T ⟶ F (b/a) U› which looks
  for the missed portion from the inner hierarchy of ‹T›, or ‹others ⟶ F (b-a) U› which looks
  horizontally from the φ-types beside, or even any mixture of the two subgoals -- some portion from inner
  and some portion beside.

  To reduce the search space, we first normalize an assertion by swapping commutative φ-type operators
  to move identical operators into the same level, so that the later reasoning only needs to consider
  horizontal splitting and merging. To do so, we assign a weight to each φ-type such that two φ-types
  are of an identical weight iff they are identical.
  φ-Types of a higher weight will sink towards the leaves during the normalization,
  so the normalization ensures ‹weight(F) ≤ weight(G)› for any normalized term ‹F (G T)› iff ‹F›
  is commutative over ‹G› and ‹F,G› have a weight.
  The weight can be annotated by users, to have a better control of the normalization,
  or simplify by lexical order if not significant.

  When identical φ-types are on the same level, the reasoning of the transformations
  ‹x ⦂ F a T ⟶ y ⦂ U› or ‹y ⦂ U ⟶ x ⦂ F a T› where a semimodule φ-type is given in one side but
  missed in the opposite side, can decide whether to embed the opposite φ-type
  ‹U› into a semimodule ‹F 1 U› of identity scalar, by checking whether the weight of ‹U› is greater than
  the weight of ‹F a T›, which implies no swappable semimodule ‹F› that can move here can be seen in ‹U›.

  If we denote ‹F > G ≜ weight(F) > weight(G) ∧ commutative(F,G)›, the normalization ensures in
  a given syntactic tree of φ-type operators, any path from the root to a leaf φ-type is non-descending,
  i.e., ‹¬ (F > G)› for any adjacent ‹F, G›, i.e., ‹F› is not heavier than ‹G› if ‹commutative(F,G)›.
  A problem is whether all syntactic tree of φ-type operators can be uniquely normalized.
  *: The check of ‹F > G› is carried by LP reasoner ‹Require_Weight_Norm› in the code.

  For the sake of unique normalization, we require all commutativity between the φ-type operators is transitive.
  We designate ‹commutative(F,G)› to mean ‹F› can be swapped into ‹G›, ‹∃f. x ⦂ F (G T) ⟶ f(x) ⦂ G (F T)›,
  but not necessarily reversely.
  The transitivity means ‹commutative(F1,F2) ∧ commutative(F2,F3) ⟶ commutative(F1,F3)›.
  If we draw a directed edge from ‹F› to ‹G› to mean ‹weight(F) < weight(G)› and ‹F› can be swapped with ‹G›
  by any steps of swapping adjacent operators in the sequence (another name of the path).
  The transitivity ensures any given sequence generates a disjoint union of several fully connected
  directed acyclic graph.
  Therefore, for any given sequence, we only need to swap any occurrences of ‹F, G› where ‹F > G› (a bubbling sort),
  and any order of swapping results in the unique normalized form, which is the topological sorting
  of the generated graph with connected components in the order of their occurrences in the sequence.
  Therefore, a path can be uniquely normalized.

  Another issue is many paths exist in the tree. We can normalize the paths one by one in any order.
  An operator ‹F› can be of multi-arity, so multiple children. Assume one path of the operand ‹Gi› is
  normalized, when the normalization of another operand ‹Gj› swaps ‹Gj› out of ‹F›, ‹Gj› is inserted
  into the normalized path of ‹Gi›, changing it from ‹Root … F Gi … Leaf› to ‹Root … Gj F Gi … Leaf›.
  The sub-sequence ‹Gi … Leaf› is unchanged but the property of ‹Root … Gj F› is temporarily broken.
  However, with the normalization of the path ‹Gj›, ‹Root … Gj F› will be normalized, and the concatenation
  of the normalized ‹Root … Gj F› with ‹Gi … Leaf› also yields a normalized path, because ‹¬ (Gi > F)›.

  Besides, not all multi-arity operator pair ‹(F,G)› has partial commutativity (in sense of fixing
  all of its operands except one, ‹F (fixed, G(T)) ⟶ G (F (fixed, T))›, so reducing the notion of
  multi-arity commutativity to the normal commutativity of single-arity type operators),
  but total commutativity where all operands are of the same φ-type and swapped together,
  e.g., ‹F (G(T), G(U)) ⟶ G (F (T, U))› and ‹F=(∗), G=((→) k)› is an instance.
  It brings no problem to the normalization, because it is swapping ‹F› and ‹G› simultaneously in
  the paths of all its operands, and this swapping is valid in either of the paths in our bubbling sort
  algorithm.

  At last, not all operators need normalization. Operators like ‹∗, +, ∧, Σ› are already handled well
  by the reasoner, so they can occur anywhere in the tree and there is no need to move them onto certain same level.
  We do not assign a weight to them so they do not have any weight relation with others.
  It optimizes the normalization performance.
›

subparagraph ‹Preliminary›

consts restore_from_semimodule :: ‹bool ⇒ ('s ⇒ ('e, 'd) φ) ⇒ action› 

declare [[ φreason_default_pattern
     ‹_ ⦂ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule True ?F› ⇒
     ‹_ ⦂ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule True ?F›     (100)
 and ‹_ ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule False ?F› ⇒
     ‹_ ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule False ?F›    (100)
]]

φreasoner_group restore_from_semimodule = (1000, [1000,1001]) for ‹_ @tag restore_from_semimodule _ _›
  ‹The reasoning later lifts a φ-type in to a semimodule with scalar one. The lifted semimodule
   not always succeeds, and may return with no change. If so, the reasoning process here, restore the
   lifted semimodule back to the original φ-type, by unwrapping the scalar one. ›

lemma [φreason %restore_from_semimodule+1]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F (introduced one) @tag restore_from_semimodule True F ›
  unfolding Module_OneI_def Action_Tag_def Transformation_def Premise_def 𝗋Guard_def
  by simp

lemma [φreason %restore_from_semimodule+1]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D f PE
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (introduced one) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ T1 @tag restore_from_semimodule False F ›
  unfolding Module_OneE_def Action_Tag_def Transformation_def Premise_def 𝗋Guard_def
  by simp

lemma [φreason %restore_from_semimodule for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ @tag restore_from_semimodule _ _›]:
  ‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag restore_from_semimodule Any F ›
  unfolding Action_Tag_def
  by simp


subparagraph ‹Main›

lemma [φreason_template default %derived_SE_inj_to_module name F.wrap_module_src]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps one b
⟹ 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) True
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F F'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
⟹ NO_SIMP (apfst f x ⦂ F (introduced one) ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F' b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ NO_SIMP (snd x ⦂ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 snd x ⦂ W  @tag restore_from_semimodule True F)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ x ⦂ T1 ✼ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F' b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
      <except-pattern> xx ⦂ F aa ✼ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F' b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
  unfolding Module_OneI_def Transformation_def Premise_def 𝗋Guard_def
            Action_Tag_def NO_SIMP_def Except_Pattern_def φProd'_def
  by (clarsimp; metis)


lemma [φreason_template default %derived_SE_inj_to_module+1 name F.wrap_module_tgt]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps a one
⟹ 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) False
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' F
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D f PE
⟹ NO_SIMP (y ⦂ F' a ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ F (introduced one) ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
⟹ NO_SIMP (snd x ⦂ R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 r ⦂ R' @tag restore_from_semimodule False F)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
⟹ y ⦂ F' a ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (f (fst x), r) ⦂ T1 ✼ R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
      <except-pattern> y ⦂ F' a ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 xx ⦂ F bb ✼ R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
  unfolding Module_OneE_def Transformation_def Premise_def 𝗋Guard_def
            Action_Tag_def NO_SIMP_def Except_Pattern_def φProd'_def
  by (clarsimp; blast)

lemma ToA_mapper_MOne_src
  [no_atp, φreason_template default %φmapToA_derived_module_wrapper name F.mapper_wrap_module_src]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps a one
⟹ 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps b one'
⟹ 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) True
⟹ 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one') True
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' F
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G'

⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one DI I1 PI
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE G U1 one' DE E1 PE

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈fst ` D. DI x ∧ DE (f (I1 x)))

⟹ 𝗆𝖺𝗉 g ⊗f r : F' a ✼ R ↦ G' b ✼ R
    𝗈𝗏𝖾𝗋 f ⊗f w : F (introduced one) ✼ W ↦ G (introduced one') ✼ W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 apfst I1 ` D

⟹ 𝗆𝖺𝗉 g ⊗f r : F' a ✼ R ↦ G' b ✼ R
    𝗈𝗏𝖾𝗋 (E1 o f o I1) ⊗f w : T1 ✼ W ↦ U1 ✼ W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o apfst I1 𝗌𝖾𝗍𝗍𝖾𝗋 apfst E1 o s 𝗂𝗇 D ›
  unfolding 𝗋Guard_def φProd'_def
  apply (simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric])
  ❴ premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[] 
    apply_rule apply_Module_OneI[OF S1I]
    apply_rule ToA_Mapper_onward[OF Tr, where x=‹apfst I1 x›]
  ❵ apply(rule conjunctionI, rule)
  ❴ premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[]
    apply_rule ToA_Mapper_backward[OF Tr] certified by (instantiate ‹x›; auto_sledgehammer) ；
    apply_rule apply_Module_OneE[OF S1E]
      certified by (insert ToA_Mapper_f_expn[OF Tr], auto_sledgehammer) ;;
  
  ❵ by (rule conjunctionI, rule, drule ToA_Mapper_f_expn_rev, clarsimp)
  

lemma ToA_mapper_MOne_tgt
  [no_atp, φreason_template default %φmapToA_derived_module_wrapper+1 name F.mapper_wrap_module_tgt]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps a one
⟹ 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps b one'
⟹ 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) False
⟹ 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (G one') False
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' F
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G
⟹ 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G'

⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI G U1 one' DI E1 PI
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one DE I1 PE

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. DE (fst (h x)) ∧ DI (g (I1 (fst (h x)))))

⟹ 𝗆𝖺𝗉 (E1 o g o I1) ⊗f r : F (introduced one) ✼ R ↦ G (introduced one') ✼ R
    𝗈𝗏𝖾𝗋 f ⊗f w : F' a ✼ W ↦ G' b ✼ W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 D

⟹ 𝗆𝖺𝗉 g ⊗f r : T1 ✼ R ↦ U1 ✼ R
    𝗈𝗏𝖾𝗋 f ⊗f w : F' a ✼ W ↦ G' b ✼ W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 apfst I1 o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o apfst E1 𝗂𝗇 D ›
  for F :: ‹'a::plus ⇒ 'b ⇒ 'c::sep_magma_1 BI›
  and T1 :: ‹'b2 ⇒ 'c BI›
  unfolding 𝗋Guard_def φProd'_def
  apply (simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric])
  ❴ premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[]
    apply_rule ToA_Mapper_onward[OF Tr, where x=‹x›]
    apply_rule apply_Module_OneE[OF S1E]
  ❵ apply(rule conjunctionI, rule)
  ❴ premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[]
    apply_rule apply_Module_OneI[OF S1I]
    certified by auto_sledgehammer ；
    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apfst E1 x›]
    certified by (insert ToA_Mapper_f_expn[OF Tr] useful; auto simp add: fun_eq_iff map_prod_def image_iff;
                  smt (verit, best) Pair_inject apfst_convE case_prod_conv)  ;;
  ❵ by(rule conjunctionI, rule, drule ToA_Mapper_f_expn_rev, clarsimp simp: Premise_def prod.map_beta)



subsubsection ‹Associativity›

lemma scalar_assoc_template[φreason_template name Fc.scalar_assoc [assertion_simps]]:
  ‹ Module_AssocI Fs Ft Fc T Ds Dt (λ_ _ _. True) smul (λ_ _ x. x)
⟹ Module_AssocE Fs Ft Fc T Ds Dt (λ_ _ _. True) smul (λ_ _ x. x)
⟹ Ds s ∧ Dt t
⟹ Fs s (Ft t T) = Fc (smul s t) T ›
  unfolding Module_AssocE_def Module_AssocI_def
  by (rule φType_eqI_Tr; simp)


lemma [φreason_template name Fc.scalar_functor [no_atp]]:
  ‹ Module_AssocI Fs' Ft' Fc' U Ds' Dt' Dx' smul' f'
⟹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ Functional_Transformation_Functor (Fs s) (Fs' s') (Ft t T) (Ft' t' U) D R pm fm
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Dt t ∧ Ds' s' ∧ Dt' t' ∧ Dx s t x ∧
           Dx' s' t' (fm g P (f s t x)) ∧ (∀ a ∈ D (f s t x). g a ∈ R (f s t x))
⟹ (⋀a ∈ D (f s t x). a ⦂ Ft t T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 g a ⦂ Ft' t' U 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫 )
⟹ x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f' s' t' (fm g P (f s t x)) ⦂ Fc' (smul' s' t') U 𝗐𝗂𝗍𝗁 pm g P (f s t x) @tag 𝒯𝒫 ›
  unfolding Module_AssocI_def Module_AssocE_def
            Transformation_def Premise_def Functional_Transformation_Functor_def
            meta_Ball_def Action_Tag_def
  by clarsimp metis
 
lemma template_scalar_partial_functor[φreason_template name Fc.scalar_partial_functor [no_atp]]:
  ‹ Module_AssocI Fs' Ft' Fc' U Ds' Dt' Dx' smul' f'
⟹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ Separation_HomoI_Cond (Fs s) FW FsW CW (Ft t T) W Dz z
⟹ Separation_HomoE_Cond (Fs' s') FR FsR CR (Ft' t' U) R Du uz
⟹ Functional_Transformation_Functor FsW FsR (Ft t T ∗ ◒[CW] W) (Ft' t' U ∗ ◒[CR] R) D Rng pm fm
⟹ (⋀a ∈ D (z (apfst (f s t) x)).
           a ⦂ Ft t T ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 g a ⦂ Ft' t' U ✼ R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫' )
⟹ SE_Has_or_Not CW W FW FW
⟹ SE_Has_or_Not CR R FR FR
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (prem, ff, PP) : (
      Dx' s' t' (fst (uz (fm g P (z (apfst (f s t) x))))) ∧ (apfst (f s t) x) ∈ Dz ∧
        (∀a ∈ D (z (apfst (f s t) x)). g a ∈ Rng (z (apfst (f s t) x))) ∧
        (fm g P (z (apfst (f s t) x))) ∈ Du,
      apfst (f' s' t') (uz (fm g P (z (apfst (f s t) x)))),
      pm g P (z (apfst (f s t) x)))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Dt t ∧ Ds' s' ∧ Dt' t' ∧ Dx s t (fst x) ∧ prem
⟹ x ⦂ Fc (smul s t) T ✼ FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ff ⦂ Fc' (smul' s' t') U ✼ FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding Action_Tag_def φProd'_def SE_Has_or_Not_alt_def
  ❴ premises SAI[] and SAE[] and SHI[] and SHE[] and FTF[] and Tr[] and [simp] and [simp]
    apply_rule transformation_right_frame_ty[OF apply_Semimodule_SAssocE[OF SAE]]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[OF FTF, where P=P, simplified]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
    apply_rule transformation_right_frame_ty[OF apply_Semimodule_SAssocI[OF SAI]]
  ❵ .


lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) True
⟹ Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ NO_SIMP (f s t x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ NO_SIMP (x ⦂ Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ›
  unfolding NO_SIMP_def Module_AssocI_def 𝗋Guard_def Premise_def Action_Tag_def
  using mk_elim_transformation by blast

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) True
⟹ Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ NO_SIMP (R * (f s t x ⦂ Fc (smul s t) T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ NO_SIMP (R * (x ⦂ Fs s (Ft t T)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ›
  unfolding Module_AssocI_def Premise_def NO_SIMP_def 𝗋Guard_def Action_Tag_def
  using transformation_left_frame mk_elim_transformation by blast

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) False
⟹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ Fc (smul s t) T 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fs s (Ft t T) 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ›
  unfolding Module_AssocE_def Premise_def NO_SIMP_def 𝗋Guard_def Action_Tag_def
  using mk_intro_transformation by blast

lemma [φreason_template default %ToA_derived_red]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) False
⟹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ Fc (smul s t) T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ Fs s (Ft t T) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ›
  unfolding Module_AssocE_def Premise_def NO_SIMP_def 𝗋Guard_def Action_Tag_def REMAINS_def
  using transformation_right_frame mk_intro_transformation by blast

lemma [φreason_template %To_ToA_derived_SAssoc]:
  ‹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fs s (Ft t T) 𝗌𝗎𝖻𝗃 y. y = f s t x @tag to (𝗌𝗉𝗅𝗂𝗍-𝖺𝗌𝗌𝗈𝖼 s t) ›
  unfolding Module_AssocE_def Premise_def 𝗋Guard_def Action_Tag_def
  by simp
  

paragraph ‹ToA-based Simplification›

lemma [φreason_template [φtransformation_based_backward_simp default %To_ToA_derived_SAssoc no trigger]]:
  ‹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ x ⦂ Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fs s (Ft t T) 𝗌𝗎𝖻𝗃 y. y = f s t x @tag 𝒜backward_simp ›
  unfolding Module_AssocE_def Premise_def 𝗋Guard_def Action_Tag_def
  by simp

lemma [φreason_template [φtransformation_based_simp default %To_ToA_derived_SAssoc no trigger]]:
  ‹ Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x
⟹ x ⦂ Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fc (smul s t) T 𝗌𝗎𝖻𝗃 y. y = f s t x @tag 𝒜simp ›
  unfolding Module_AssocI_def Premise_def 𝗋Guard_def Action_Tag_def
  by simp


subsubsection ‹Scalar Distributivity›

lemma [φreason_template name F.unfold_sdistr[]]:
  ‹ Module_Distr_HomoS F Ds Du uz
⟹ Module_Distr_HomoZ F Ds Dz zi
⟹ Ds s ∧ Ds t ∧ s ##+ t ∧ Du s t x ∧ Dz s t (uz s t x) ∧
    zi s t (uz s t x) = x
⟹ (x ⦂ F (s + t)) = (uz s t x ⦂ F s ∗ F t) ›
  unfolding Module_Distr_HomoZ_def Module_Distr_HomoS_def
  by (rule assertion_eq_intro; clarsimp simp del: split_paired_All; metis)

paragraph ‹Checking of Non-SDistr›

lemma [φreason_template 0]:
  ‹ Semimodule_No_SDistr F
⟹ Module_Distr_HomoS F Ds Du uz
⟹ ERROR TEXT(F ‹is declared as non-scalar-associative but a property is given›
               (Module_Distr_HomoS F Ds Du uz)) @tag 𝒜_template_reason undefined
⟹ True›
  ..

lemma [φreason_template 0]:
  ‹ Semimodule_No_SDistr F
⟹ Module_Distr_HomoZ F Ds Du uz
⟹ ERROR TEXT(F ‹is declared as non-scalar-associative but a property is given›
               (Module_Distr_HomoZ F Ds Du uz)) @tag 𝒜_template_reason undefined
⟹ True›
  ..


paragraph ‹Zip›

lemma SDirst_in_comm_scalar_implies_revZ
      [φadding_property = false,
       φreason default %φTA_fallback_lattice,
       φadding_property = true]:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ Module_Distr_HomoZ_rev F Ds Dx z Dx z›
  for F :: ‹('s::partial_ab_semigroup_add ⇒ ('c::sep_magma,'a) φ)›
  unfolding Module_Distr_HomoZ_rev_def Module_Distr_HomoZ_def
  by (simp add: dom_of_add_commute partial_add_commute)

lemma SDirst_in_comm_sep_implies_revZ
      [φadding_property = false,
       φreason default %φTA_fallback_lattice-1,
       φadding_property = true]:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ Module_Distr_HomoZ_rev F Ds Dx z (λs t. Dx t s o prod.swap) (λs t. z t s o prod.swap)›
  for F :: ‹('s::partial_add_magma ⇒ ('c::sep_ab_semigroup,'a) φ)›
  unfolding Module_Distr_HomoZ_rev_def Module_Distr_HomoZ_def
  by (simp add: φProd_expn'; metis mult.commute)


paragraph ‹Unzip›

lemma SDirst_in_comm_scalar_implies_revU
      [φadding_property = false,
       φreason default %φTA_fallback_lattice,
       φadding_property = true]:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ Module_Distr_HomoS_rev F Dx uz Ds Dx uz›
  for F :: ‹('s::partial_ab_semigroup_add ⇒ ('c::sep_magma,'a) φ)›
  unfolding Module_Distr_HomoS_rev_def Module_Distr_HomoS_def
  by (simp add: dom_of_add_commute partial_add_commute)

lemma SDirst_in_comm_sep_implies_revU
      [φadding_property = false,
       φreason default %φTA_fallback_lattice-1,
       φadding_property = true]:
  ‹ Module_Distr_HomoS F Ds Dx z
⟹ Module_Distr_HomoS_rev F Dx uz Ds (λs t. Dx t s) (λs t. prod.swap o z t s)›
  for F :: ‹('s::partial_add_magma ⇒ ('c::sep_ab_semigroup,'a) φ)›
  unfolding Module_Distr_HomoS_rev_def Module_Distr_HomoS_def
  by (clarsimp simp add: φProd_expn'' mult.commute)

lemma [φreason_template %To_ToA_derived_SDistri]:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F s ∗ F t 𝗌𝗎𝖻𝗃 y. y = uz s t x @tag to (𝗌𝗉𝗅𝗂𝗍-𝗌𝖼𝖺𝗅𝖺𝗋 s t) ›
  unfolding Module_Distr_HomoS_def Premise_def Action_Tag_def
  by simp


subsection ‹Separation Extraction›

subsubsection ‹Transformation Functors›



(* This crazy rule is for the boundary cases when we reason the last element and when the algebra doesn't
   have an identity element so that we cannot reduce it to the usual case by adding an identity element at the tail.

The idea is to lift the non-unital algebra by adding an identity element. We use const‹●› for it.
But it is not the end. Because substantially its reasoning has no identity element, we have to use
term‹◒[Cw] W› with a boolean flag ‹Cw› to rudimentarily check if the remainder is needed or not.

If u cannot use the identity element, the reasoning itself changes,
like sometimes you have to apply Sep_Homo zipper while in another case you shouldn't use that.
There is no trivial degeneration of Sep_Homo. There is no an identity element representing nothing.
So if u are going to zip something, u really need to zip some two concrete things,
instead of using the identity element to represent the degenerated situation where you actually zipped nothing.
It forces us to really consider the cases of having remainders or not in the reasoning.

The rule below is complicated, but is branch-less in reasoning. All branch expressions are in object level,
free from explosion of expression, and can be simplified easily because the boolean flags are
assigned by constants after the reasoning.

*)

 
paragraph ‹Transformation Functor›

lemma [φreason_template default %derived_SE_functor name F1.separation_extraction]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F14 F23 (T ∗ ◒[Cw] W) (U ∗ ◒[Cr] R) Dom Rng pred_mapper func_mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI_Cond F1 F4 F14 Cw T W Dz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE_Cond F3 F2 F23 Cr U R Du uz
⟹ (⋀a ∈ Dom (z x).
      a ⦂ T ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a ⦂ U ✼ R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫' )
⟹ SE_Has_or_Not Cw W F4 FW
⟹ SE_Has_or_Not Cr R F2 FR
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (y, prem, PP) :
        (uz (func_mapper f P (z x)),
         (y = uz (func_mapper f P (z x)) ⟶
              x ∈ Dz ∧ (∀a. a ∈ Dom (z x) ⟶ f a ∈ Rng (z x))
                     ∧ func_mapper f P (z x) ∈ Du),
         pred_mapper f P (z x))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
⟹ x ⦂ F1 T ✼ FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 U ✼ FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding 𝗋Guard_def SE_Has_or_Not_alt_def φProd'_def
  ❴ premises FTF[] and SHI[] and SHE[] and Tr and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF, simplified]
    ❴ Tr ❵ ；
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
  ❵ .


subparagraph ‹With Parameterization›

lemma "_Structural_ExtractΛ_general_rule_i_"[φreason_template default %derived_SE_functor]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_FunctorΛ F14 F23 (λp. T p ∗ ◒[Cw] W p) (λp. U p ∗ ◒[Cr] R p) Dom Rng pred_mapper func_mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoΛI_Cond F1 F4 F14 Cw T W Dz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoΛE_Cond F3 F2 F23 Cr U R Du uz
⟹ (⋀p. ⋀a ∈ Dom p (z x).
          a ⦂ T p ✼ W p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a ⦂ U p ✼ R p 𝗐𝗂𝗍𝗁 P p a @tag 𝒯𝒫' )
⟹ SE_Has_or_NotΛ Cw W F4 FW
⟹ SE_Has_or_NotΛ Cr R F2 FR
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 (y, prem, PP) :
      (uz (func_mapper f P (z x)),
       (y = uz (func_mapper f P (z x)) ⟶
        x ∈ Dz ∧ (∀p a. a ∈ Dom p (z x) ⟶ f p a ∈ Rng p (z x))
               ∧ func_mapper f P (z x) ∈ Du),
       pred_mapper f P (z x))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
⟹ x ⦂ F1 T ✼ FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 U ✼ FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding 𝗋Guard_def SE_Has_or_NotΛ_alt_def φProd'_def
  apply simp
  ❴ premises FTF[] and SHI[] and SHE[] and Tr and [simp] and [simp]
    apply_rule apply_Separation_HomoΛI_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_Transformation_FunctorΛ[where f=f and P=P, OF FTF, simplified]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoΛE_Cond[OF SHE, simplified]
  ❵ .



paragraph ‹Bi-Functor›

lemma [φreason_template default %derived_SE_functor name F1.separation_extraction]:

  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_BiFunctor F14 F23
            (T1 ∗ ◒[Cw] W1) (T2 ∗ ◒[Cw] W2) (U1 ∗ ◒[Cr] R1) (U2 ∗ ◒[Cr] R2)
            Dom1 Dom2 Rng1 Rng2 pred_mapper func_mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI2_Cond F1 F4 F14 Cw T1 T2 W1 W2 Dz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE2_Cond F3 F2 F23 Cr U1 U2 R1 R2 Du uz
⟹ (⋀a ∈ Dom1 (z x). a ⦂ T1 ✼ W1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ U1 ✼ R1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫' )
⟹ (⋀a ∈ Dom2 (z x). a ⦂ T2 ✼ W2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 ✼ R2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫' )
⟹ SE_Has_or_Not2 Cw W1 W2 F4 FW
⟹ SE_Has_or_Not2 Cr R1 R2 F2 FR
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (y, prem, PP) :
        (uz (func_mapper f1 f2 P1 P2 (z x)),
         (y = uz (func_mapper f1 f2 P1 P2 (z x)) ⟶
              x ∈ Dz
              ∧ (∀a. a ∈ Dom1 (z x) ⟶ f1 a ∈ Rng1 (z x))
              ∧ (∀a. a ∈ Dom2 (z x) ⟶ f2 a ∈ Rng2 (z x))
              ∧ func_mapper f1 f2 P1 P2 (z x) ∈ Du),
         pred_mapper f1 f2 P1 P2 (z x))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
⟹ x ⦂ F1 T1 T2 ✼ FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 U1 U2 ✼ FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding 𝗋Guard_def SE_Has_or_Not2_alt_def φProd'_def
  ❴ premises FTF[] and SHI[] and SHE[] and Tr1 and Tr2 and [simp] and [simp]
    apply_rule apply_Separation_HomoI2_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_Transformation_BiFunctor[where P1=P1 and P2=P2, OF FTF, simplified]
    ❴ Tr1 ❵
    ❴ Tr2 ❵ 
    apply_rule apply_Separation_HomoE2_Cond[OF SHE, simplified]
  ❵ .

paragraph ‹CV-Functor›

lemma [φreason_template default %derived_SE_functor name F1.separation_extraction]:

  ‹ 𝗀𝗎𝖺𝗋𝖽 Fun_CV_TrFunctor F14 F23
            (T1 ∗ ◒[Cw] W1) (T2 ∗ ◒[Cw] W2) (U1 ∗ ◒[Cr] R1) (U2 ∗ ◒[Cr] R2)
            Dom1 Dom2 FC1 Rng2 pred_mapper func_mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI2_Cond F1 F4 F14 Cw T1 T2 W1 W2 Dz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE2_Cond F3 F2 F23 Cr U1 U2 R1 R2 Du uz
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 f1 a ∈ Dom1 (z x)
        ⟹ a ⦂ U1 ✼ R1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a ⦂ T1 ✼ W1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫' )
⟹ (⋀a ∈ Dom2 (z x). a ⦂ T2 ✼ W2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a ⦂ U2 ✼ R2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫' )
⟹ SE_Has_or_Not2 Cw W1 W2 F4 FW
⟹ SE_Has_or_Not2 Cr R1 R2 F2 FR
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (y, prem, PP) :
        (uz (func_mapper f1 f2 P1 P2 (z x)),
         (y = uz (func_mapper f1 f2 P1 P2 (z x)) ⟶
              x ∈ Dz
              ∧ FC1 f1 (z x)
              ∧ (∀a. a ∈ Dom2 (z x) ⟶ f2 a ∈ Rng2 (z x))
              ∧ func_mapper f1 f2 P1 P2 (z x) ∈ Du),
         pred_mapper f1 f2 P1 P2 (z x))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
⟹ x ⦂ F1 T1 T2 ✼ FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 U1 U2 ✼ FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫' ›
  unfolding 𝗋Guard_def SE_Has_or_Not2_alt_def φProd'_def
  ❴ premises FTF[] and SHI[] and SHE[] and Tr1 and Tr2 and [simp] and [simp]
    apply_rule apply_Separation_HomoI2_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_CV_BiFunctor[where f1=f1 and P1=P1 and P2=P2, OF FTF, simplified]
    ❴ Tr1 ❵
    ❴ Tr2 ❵
    apply_rule apply_Separation_HomoE2_Cond[OF SHE, simplified]
  ❵ .


subsubsection ‹Transformation Mapper›


context 
  notes φProd_expn''[simp, φprogramming_simps] prod_opr_norm[simp] boolean_conversions[simp]
begin

lemma ToA_mapper_sep_template [φreason_template default %φmapToA_derived_TF name F1.ToA_mapper_sep]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F14 F23 (T ∗ ◒[CW] W) (U ∗ ◒[CR] R) Dom Rng pred_mapper func_mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 Parameter_Variant_of_the_Same_TypOpr F14 F14'
⟹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F23' F14' (U' ∗ ◒[CR] R') (T' ∗ ◒[CW] W') Dom' Rng' pred_mapper' func_mapper'
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI_Cond F1 F4 F14 CW T W Dz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI_Cond F3' F2' F23' CR U' R' Dz' z'
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE_Cond F3 F2 F23 CR U R Du uz
⟹ 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE_Cond F1' F4' F14' CW T' W' Du' uz'
⟹ compositional_mapper m1 (λh. func_mapper h (λ_. True)) m2 Dm1 (g ⊗f r) h @tag 𝒜_template_reason undefined
⟹ separatable_cond_unzip CR z' uz Dus m1 mg mr g r @tag 𝒜_template_reason undefined
⟹ compositional_mapper (λs. func_mapper' s (λ_. True)) m2 m3 Dm2 s (g ⊗f r o h) @tag 𝒜_template_reason undefined
⟹ separatable_cond_zip CW uz' z Dzs m3 mf mw f w @tag 𝒜_template_reason undefined
⟹ domain_by_mapper Dom' m2 Dom (g ⊗f r o h) Ddm @tag 𝒜_template_reason undefined
⟹ domain_of_inner_map m3 Dm3 @tag 𝒜_template_reason undefined

⟹ 𝗆𝖺𝗉 g ⊗f r : U ✼ R ↦ U' ✼ R'
    𝗈𝗏𝖾𝗋 f ⊗f w : T ✼ W ↦ T' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 ⋃ (Dom ` z ` D)

⟹ SE_Has_or_Not CW W  F4  FW
⟹ SE_Has_or_Not CW W' F4' FW'
⟹ SE_Has_or_Not CR R  F2  FR
⟹ SE_Has_or_Not CR R' F2' FR'
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] (CR ∨ r = (λ_. unspec)) ∧ (CW ∨ w = (λ_. unspec))

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D.
      x ∈ Dz ∧ x ∈ Dzs ∧ z x ∈ Dm1 ∧ z x ∈ Dm2 ∧ z x ∈ Ddm ∧
      (∀a ∈ Dm3 (z x). a ∈ Dom (z x)) ∧
      (∀a ∈ Dom (z x). h a ∈ Rng (z x)) ∧
      (let x1 = func_mapper h  (λ_. True) (z x) in
            x1 ∈ Du ∧ x1 ∈ Dus ∧
            (mg g ⊗f mr r) (uz x1) ∈ Dz' ∧
            (∀a ∈ Dom' (m2 (g ⊗f r o h) (z x)). s a ∈ Rng' (m2 (g ⊗f r o h) (z x))) ∧
            m3 (f ⊗f w) (z x) ∈ Du') )

⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 h' : uz o func_mapper h (λ_. True) o z @tag 𝒜_template_reason undefined
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 s' : uz' o func_mapper' s (λ_. True) o z' @tag 𝒜_template_reason undefined
⟹ 𝗆𝖺𝗉 mg g ⊗f mr r : F3 U ✼ FR ↦ F3' U' ✼ FR'
    𝗈𝗏𝖾𝗋 mf f ⊗f mw w : F1 T ✼ FW ↦ F1' T' ✼ FW'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h' 𝗌𝖾𝗍𝗍𝖾𝗋 s' 𝗂𝗇 D›

  unfolding 𝗋Guard_def Action_Tag_def separatable_unzip_def compositional_mapper_def
            separatable_zip_def domain_of_inner_map_def NO_SIMP_def domain_by_mapper_def
            separatable_cond_unzip_def separatable_cond_zip_def φProd'_def SE_Has_or_Not_alt_def
  ❴ premises FTF[] and [] and FTF'[] and SHI[] and SHI'[] and SHE[] and SHE'[]
         and [useful] and [useful] and [useful] and [useful] and [useful] and [] and Tr
         and [simp] and [simp] and [simp] and [simp] and _
         and _ and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=h and P=‹λ_. True›, OF FTF, simplified]
    ❴ apply_rule ToA_Mapper_onward[OF Tr, simplified] ❵
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified] certified by (metis the_φ(3) the_φ(4))
  ❵ apply (rule conjunctionI, rule, simp add: image_image del: split_paired_All)
  ❴ premises FTF[] and [] and FTF'[] and SHI[] and SHI'[] and SHE[] and SHE'[]
         and [useful] and [useful] and [useful] and [useful] and DM and DiM and Tr
         and [simp] and [simp] and [simp] and [simp] and t1
         and _ and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[OF SHI', simplified]
    certified by (instantiate ‹x›, insert useful(1), simp add: image_iff, elim bexE, metis the_φ(4)) ;;
  
    apply_rule apply_Functional_Transformation_Functor[where f=s and P=‹λ_. True›, OF FTF', simplified]
    ❴ for a
      apply_rule ToA_Mapper_backward[OF Tr, simplified]
      certified proof (instantiate ‹a›,
                      insert ‹a ∈ Dom' (z' x)› ‹x ∈ (λx. (mg g ⊗f mr r) (uz (func_mapper h (λ_. True) (z x)))) ` D›,
                      simp add: image_iff, elim bexE)
                  fix xa :: "'o × 'p"
                  assume a1: "xa ∈ D"
                  assume a2: "a ∈ Dom' (z' x)"
                  assume a3: "x = (mg g ⊗f mr r) (uz (func_mapper h (λ_. True) (z xa)))"
                  have t1: "func_mapper h (λp. True) (z xa) ∈ Dus"
                    using a1 by (metis (no_types) the_φ(5))
                  show "∃p∈D. ∃p∈Dom (z p). a = (g ⊗f r) (h p)"
                  proof (rule bexI[OF _ a1])
                    have "∀P p f. ∃pa. ((p::'l × 'm) ∉ f ` P ∨ (pa::'a × 'b) ∈ P) ∧ (p ∉ f ` P ∨ f pa = p)"
                      by blast
                    then show "∃p∈Dom (z xa). a = (g ⊗f r) (h p)"
                      by (cases ‹CR›,
                          smt (z3) DM a1 a2 a3 subsetD the_φ(10) the_φ(11) the_φ(5),
                          smt (z3) DM a1 a2 a3 subsetD the_φ(10) the_φ(11) the_φ(5) the_φ(7))
                  qed
                qed 
    ❵ ； certified by (insert useful(1), simp add: image_iff, elim bexE,
                      metis the_φ(3) the_φ(5) the_φ(8) the_φ(9)) ；
    apply_rule apply_Separation_HomoE_Cond[OF SHE', simplified]
        certified proof -
          obtain y where t1: ‹y ∈ D› and t2: ‹x = (mg g ⊗f mr r) (uz (func_mapper h (λ_. True) (z y)))›
            by (insert useful(2), blast)
          have t3: ‹Dm3 (z y) ⊆ Dom (z y)›
            using t1 the_φ(4) by fastforce
          have t4: ‹m3 (s ∘ (g ⊗f r ∘ h)) (z y) = m3 (f ⊗f w) (z y)›
            by (insert ToA_Mapper_f_expn[OF Tr], clarsimp,
                metis (mono_tags, opaque_lifting) DiM comp_apply t1 the_φ(4))
          show ?thesis
            by (insert ‹∀x∈D. _›[THEN bspec[OF _ t1]], simp add: t2 t4[symmetric],
                metis the_φ(10) the_φ(6) the_φ(8) the_φ(9))
        qed
  ❵ apply (rule conjunctionI, simp, drule ToA_Mapper_f_expn,
        simp add: Premise_def Simplify_def subset_iff del: split_paired_All,
        rule)
    subgoal premises prems for x
    proof -
      have t1: ‹Dm3 (z x) ⊆ Dom (z x)›
        using prems(19) prems(23) by blast
      have t2: ‹m3 (s ∘ (g ⊗f r ∘ h)) (z x) = m3 (f ⊗f w) (z x)›
        by (rule ‹∀f g x. (∀a∈Dm3 x. f a = g a) ⟶ m3 f x = m3 g x›[THEN spec, THEN spec, THEN spec, THEN mp],
            insert prems(22) prems(23) t1, fastforce)
      show ?thesis
        by (metis prems(10) prems(11) prems(18) prems(19) prems(23) prems(8) prems(9) t2)
    qed .





lemma ToA_mapper_template[φreason_template default %φmapToA_derived_TF name F1.ToA_mapper]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F1 F2 T U Dom Rng pred_mapper func_mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 Parameter_Variant_of_the_Same_TypOpr F1 F1'
⟹ 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F2' F1' U' T' Dom' Rng' pred_mapper' func_mapper'

⟹ compositional_mapper m1 (λh. func_mapper h (λ_. True)) m2 Dm1 g h @tag 𝒜_template_reason undefined
⟹ compositional_mapper (λs. func_mapper' s (λ_. True)) m2 m3 Dm2 s (g o h) @tag 𝒜_template_reason undefined
⟹ domain_by_mapper Dom' m2 Dom (g o h) Ddm @tag 𝒜_template_reason undefined
⟹ domain_of_inner_map m3 Dm3 @tag 𝒜_template_reason undefined

⟹ 𝗆𝖺𝗉 g : U ↦ U' 𝗈𝗏𝖾𝗋 f : T ↦ T'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 ⋃ (Dom ` D)

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D.
      x ∈ Dm1 ∧ x ∈ Dm2 ∧ x ∈ Ddm ∧
      (∀a ∈ Dm3 x. a ∈ Dom x) ∧
      (∀a ∈ Dom x. h a ∈ Rng x) ∧
      (let x1 = func_mapper h (λ_. True) x in
            (∀a ∈ Dom' (m2 (g o h) x). s a ∈ Rng' (m2 (g o h) x)) ))

⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 h' : func_mapper h (λ_. True) @tag 𝒜_template_reason undefined
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 s' : func_mapper' s (λ_. True) @tag 𝒜_template_reason undefined
⟹ 𝗆𝖺𝗉 m1 g : F2 U ↦ F2' U' 𝗈𝗏𝖾𝗋 m3 f : F1 T ↦ F1' T'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h' 𝗌𝖾𝗍𝗍𝖾𝗋 s' 𝗂𝗇 D›

  unfolding 𝗋Guard_def Action_Tag_def compositional_mapper_def
            domain_of_inner_map_def NO_SIMP_def domain_by_mapper_def
  ❴ premises FTF[] and [] and FTF'[] and [useful] and [useful] and [useful] and [useful] and Tr
         and _ and [simp] and [simp]
    apply_rule apply_Functional_Transformation_Functor[where U=U and f=h and P=‹λ_. True›, OF FTF]
    ❴ apply_rule ToA_Mapper_onward[OF Tr] ❵
  ❵ apply (rule conjunctionI, rule)
  ❴ premises FTF[] and [] and FTF'[] and [useful] and [useful] and [useful] and [useful] and Tr
         and _ and [simp] and [simp]
    apply_rule apply_Functional_Transformation_Functor[where f=s and P=‹λ_. True›, OF FTF']
    ❴ for a apply_rule ToA_Mapper_backward[OF Tr]
      certified by (insert ‹a ∈ Dom' x› ‹x ∈ m1 g ` func_mapper h (λ_. True) ` D›,
                      simp add: image_iff, elim bexE,
                      insert the_φ(4) the_φ(6) the_φ(8), fastforce)
    ❵
  ❵
  by (rule conjunctionI, simp, drule ToA_Mapper_f_expn,
      simp add: Premise_def Simplify_def subset_iff del: split_paired_All)




end


subsubsection ‹Semimodule Scalar Associative \label{Semimodule-Scalar-Associative}›

text ‹The proof search is inefficient for semimodule φ-type that satisfies both scalar associativity
  and scalar distributivity.
  This inefficiency stems from the two properties deriving rules that can be interchangeably applied.
  Given a φ-type ‹F a T› and expect ‹F b U› with ‹a ≠ b›, we might identify some ‹c› with ‹c * a = b›,
  so we apply the associative rule and go to element transformations expecting the inner φ-type ‹T›
  might supply the missing ‹F c U›;
  alternatively we can also identify a certain ‹c› with ‹c + a = b›, so we apply the distributive rule
  and hope the unexplored external portion of assertion contains the ‹F c U›.
  The situation is further complicated when the two rules are combined: the inner φ-type ‹T› may
  contain some part ‹c1› while the external part contains the remaining part ‹c2›,
  ‹c2 + c1 * a = b›.

  To tackle this complexity, we introduce a normalization step before the reasoning,
  where we exhaustively apply the associative rules to eliminate any further need for them in the later reasoning.
  Viewing a φ-type expression as a tree with type operators as nodes and atomic types as leaves,
  we push every module-like type operators ‹F a T› all the way down to the leaves, passing through type
  connectives like ‹∗› and ‹→› by meas of homomorphic rules like ‹F a (T ∗ U) = (F a T) ∗ (F a U)›.
  In this way, all the module operator are gathered at the leaves.
  By exhaustively applying the associative rules on them, any need of associative rules
  is fully addressed, and consequently, in the subsequent reasoning, we can exclusively focus on
  the scalar distribution rules.

  Sure it raises further works for deriving the homomorphic rules. It can be done by a deriver generating
  that ....
›

text ‹According to the discussion above, the rule below should be used only for non-distributive scalars.›

(*preserved for documenting

lemma SE_general_Semimodule_Scalar_left: (*need test, to be tested once we have usable test case*)
  ‹ 𝗀𝗎𝖺𝗋𝖽 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 c * a = b) ∧𝗋 Prem
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a ∧ Ds b ∧ Ds c
⟹ Functional_Transformation_Functor F14 F23 Dom Rng mapper Prem pred_mapper func_mapper
⟹ Module_Assoc F3 U Ds
⟹ Module_Assoc F4 W Ds
⟹ Separation_HomoI (F1 a) (F4 a) F14 T (F4 c W) Dz z
⟹ Separation_HomoE (F3 a) (F2 a) F23 (F3 c U) R uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Dz ∧ (∀a. a ∈ Dom (z x) ⟶ f a ∈ Rng (z x))
⟹ (⋀x ∈ Dom (z x). x ⦂ T ∗ F4 c W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F3 c U ∗ R 𝗐𝗂𝗍𝗁 P x @tag 𝒜SE )
⟹ x ⦂ F1 a T ∗ F4 b W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz (func_mapper f P (z x)) ⦂ F3 b U ∗ F2 a R 𝗐𝗂𝗍𝗁 pred_mapper f P (z x) @tag 𝒜SE ›
  unfolding 𝗋Guard_def Ant_Seq_imp
  ❴ premises _ and [φreason add] and _
         and FTF and LSF3[φreason add] and LSF4[φreason add] and _ and _
         and _ and Tr
    interpret Functional_Transformation_Functor F14 F23 Dom Rng mapper Prem pred_mapper func_mapper
      using FTF .
    have F4D: ‹F4 b W = F4 a (F4 c W)›
      by (simp add: ‹Ds a ∧ Ds b ∧ Ds c› the_φ(6))
    have F3D: ‹F3 b U = F3 a (F3 c U)›
      by (simp add: ‹Ds a ∧ Ds b ∧ Ds c› the_φ(6)) ;;
    unfold F4D
    apply_rule apply_Separation_HomoI[where Fu=‹F4 a› and Ft=‹F1 a›]
    apply_rule functional_transformation[where U=‹F3 c U ∗ R› and f=f and P=P]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoE[where x=‹func_mapper f P (z x)›]
    fold F3D
  ❵ .

declare SE_general_Semimodule_Scalar_left[THEN 𝒜SE_clean_waste, φreason_template default 30]
  ― ‹The priority is smaller than the default rule of functional transformation›
*)

lemma SE_Semimodule_Scalar_right
      [φreason_template default %derived_SE_scalar_assoc name: F3b.ToR_scala_assoc_right]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a ∧ Dc c
⟹ Module_AssocI F3a F3c F3b U Da Dc Dx smul gs
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F1
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F4
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F2
⟹ Functional_Transformation_Functor (F1 a) (F3a a) T (F3c c U) Dom Rng pred_mapper func_mapper
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a. a ∈ Dom x ⟶ f a ∈ Rng x) ∧ Dx a c (func_mapper f P x)
⟹ (⋀x ∈ Dom x. x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F3c c U 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)
⟹ x ⦂ F1 a T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 gs a c (func_mapper f P x) ⦂ F3b b U
    𝗐𝗂𝗍𝗁 pred_mapper f P x @tag 𝒯𝒫 ›
  unfolding 𝗋Guard_def common_multiplicator_2_def
  ❴ premises [simp] and _ and SA[] and _ and _ and _ and FTF[] and _ and Tr[]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF]
    ❴ Tr ❵
    apply_rule apply_Semimodule_SAssocI[OF SA]
  ❵ .

lemma SE_Semimodule_Scalar_left
      [φreason_template default %derived_SE_scalar_assoc name: F1b.ToR_scala_assoc_left]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a ∧ Dc c
⟹ Module_AssocE F1a F1c F1b T Da Dc Dx smul gs
⟹ Type_Variant_of_the_Same_Scalar_Mul F1a F3
⟹ Type_Variant_of_the_Same_Scalar_Mul F1a F4
⟹ Type_Variant_of_the_Same_Scalar_Mul F1a F2
⟹ Functional_Transformation_Functor (F1a a) (F3 a) (F1c c T) U Dom Rng pred_mapper func_mapper
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Dx a c x ∧ (∀e ∈ Dom (gs a c x). f e ∈ Rng (gs a c x)) ∧
           func_mapper f P (gs a c x) ∈ Du
⟹ (⋀x ∈ Dom (gs a c x). x ⦂ F1c c T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ U 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫 )
⟹ x ⦂ F1b b T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P (gs a c x) ⦂ F3 a U
    𝗐𝗂𝗍𝗁 pred_mapper f P (gs a c x) @tag 𝒯𝒫 ›
  unfolding 𝗋Guard_def common_multiplicator_2_def
  ❴ premises A and _ and SA[] and _ and _ and _ and FTF[] and _ and Tr[]
    apply_rule apply_Semimodule_SAssocE[where s=a and t=c and smul=smul, OF SA, unfolded A]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF]
    ❴ Tr ❵
  ❵ .



lemma SE_Semimodule_Scalar_partial_right:
  ‹ 𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a ∧ Dc c
⟹ Module_AssocI F3a F3c F3b U Da Dc Dx smul gs
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F1
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F4
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F2
⟹ Separation_HomoI_Cond (F1 a) (F4 a) F14 CW T W Dz z
⟹ Separation_HomoE_Cond (F3a a) (F2 a) F23 CR (F3c c U) R Du uz
⟹ Functional_Transformation_Functor F14 F23 (T ∗ ◒[CW] W) (F3c c U ∗ ◒[CR] R) Dom Rng pred_mapper func_mapper
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Dz ∧ (∀a. a ∈ Dom (z x) ⟶ f a ∈ Rng (z x)) ∧
           func_mapper f P (z x) ∈ Du ∧
           Dx a c (fst (uz (func_mapper f P (z x))))
⟹ (⋀a ∈ Dom (z x). a ⦂ T ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a ⦂ F3c c U ✼ R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫' )
⟹ SE_Has_or_Not CW W (F4 a) FW
⟹ SE_Has_or_Not CR R (F2 a) FR
⟹ x ⦂ F1 a T ✼ FW
    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst (gs a c) (uz (func_mapper f P (z x))) ⦂ F3b b U ✼ FR
    𝗐𝗂𝗍𝗁 pred_mapper f P (z x) @tag 𝒯𝒫' ›
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def SE_Has_or_Not_alt_def
  ❴ premises [simp] and _ and SA and _ and _ and _ and SHI and SHE and FTF and _ and Tr and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF, simplified]
    ❴ Tr ❵ certified by auto_sledgehammer ；
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
    apply_rule apply_Semimodule_SAssocI[OF SA, THEN transformation_right_frame_ty, simplified]
  ❵ .

declare SE_Semimodule_Scalar_partial_right[(*THEN SE_clean_waste,*)
    φreason_template default %derived_SE_scalar_assoc name: F3b.ToR_scala_assoc_partial_right]


lemma SE_Semimodule_Scalar_partial_left
      [φreason_template default %derived_SE_scalar_assoc name: F1b.ToR_scala_assoc_partial_left]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a ∧ Dc c
⟹ Module_AssocE F1a F1c F1b T Da Dc Dx smul gs
⟹ Type_Variant_of_the_Same_Scalar_Mul F1a F3
⟹ Type_Variant_of_the_Same_Scalar_Mul F1a F4
⟹ Type_Variant_of_the_Same_Scalar_Mul F1a F2
⟹ Separation_HomoI_Cond (F1a a) (F4 a) F14 CW (F1c c T) W Dz z
⟹ Separation_HomoE_Cond (F3 a) (F2 a) F23 CR U R Du uz
⟹ Functional_Transformation_Functor F14 F23 (F1c c T ∗ ◒[CW] W) (U ∗ ◒[CR] R) Dom Rng pred_mapper func_mapper
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 apfst (gs a c) x ∈ Dz ∧ Dx a c (fst x) ∧
           (∀x' ∈ Dom (z (apfst (gs a c) x)). f x' ∈ Rng (z (apfst (gs a c) x))) ∧
           func_mapper f P (z (apfst (gs a c) x)) ∈ Du
⟹ (⋀a ∈ Dom (z (apfst (gs a c) x)). a ⦂ F1c c T ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a ⦂ U ✼ R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫')
⟹ SE_Has_or_Not CW W (F4 a) FW
⟹ SE_Has_or_Not CR R (F2 a) FR
⟹ x ⦂ F1b b T ✼ FW
    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz (func_mapper f P (z (apfst (gs a c) x))) ⦂ F3 a U ✼ FR
    𝗐𝗂𝗍𝗁 pred_mapper f P (z (apfst (gs a c) x)) @tag 𝒯𝒫' ›
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def SE_Has_or_Not_alt_def
  ❴ premises A and _ and SA[] and _ and _ and _ and SHI[] and SHE[] and FTF[] and _ and Tr[] and [simp] and [simp]
    apply_rule apply_Semimodule_SAssocE[where s=a and t=c and smul=smul, OF SA, unfolded A, simplified]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF, simplified]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
  ❵ .

paragraph ‹Transformation Mapper›


lemma SE_Module_scalar_assoc_mapper_tgt_template
      [no_atp, φreason_template default %φmapToA_derived_module_assoc name F3b.assoc_mapper_tgt]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a ∧ b' = b ∧ Da a ∧ Dc c
⟹ Module_AssocI F3a F3c F3b U Da Dc Dx smul gI
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F3a'
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F1
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F1'
⟹ Module_AssocE F3a' F3c' F3b' U' Da Dc Dx' smul gE

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. Dx a c (fst (h x)) ∧ Dx' a c (g (gI a c (fst (h x)))))

⟹ 𝗆𝖺𝗉 (gE a c o g o gI a c) ⊗f r : F3a a (F3c c U) ✼ R ↦ F3a' a (F3c' c U') ✼ R'
    𝗈𝗏𝖾𝗋 f ⊗f w : F1 a T ✼ W ↦ F1' a T' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 D

⟹ 𝗆𝖺𝗉 g ⊗f r : F3b b U ✼ R ↦ F3b' b' U' ✼ R'
    𝗈𝗏𝖾𝗋 f ⊗f w : F1 a T ✼ W ↦ F1' a' T' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 apfst (gI a c) o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o apfst (gE a c)
      𝗂𝗇 D ›
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def
❴ premises A and _ and SAI[] and [] and [] and [] and SAE[] and _ and Tr[]
  apply_rule ToA_Mapper_onward[OF Tr, where x=x]
  apply_rule apply_Semimodule_SAssocI[where s=a and t=c, OF SAI, unfolded A]
❵ apply (rule conjunctionI, rule)
❴ premises A and B and SAI[] and [] and [] and [] and SAE[] and _ and Tr[] 
  unfold ‹b' = b›
  apply_rule apply_Semimodule_SAssocE[where s=a and t=c, OF SAE, unfolded A]
    certified by auto_sledgehammer ;;
  apply_rule ToA_Mapper_backward[OF Tr, where x=‹apfst (gE a c) x›]
    certified by (insert ToA_Mapper_f_expn[OF Tr], auto_sledgehammer) ;;
  fold ‹a' = a›
❵ by (rule conjunctionI, rule, drule ToA_Mapper_f_expn, clarsimp simp: prod.map_beta)


lemma SE_Module_scalar_assoc_mapper_src_template
      [no_atp, φreason_template default %φmapToA_derived_module_assoc name F3b.assoc_mapper_src]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a ∧ b' = b ∧ Da a ∧ Dc c
⟹ Module_AssocE F3a F3c F3b U Da Dc Dx smul gE
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F3a'
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F1
⟹ Type_Variant_of_the_Same_Scalar_Mul F3a F1'
⟹ Module_AssocI F3a' F3c' F3b' U' Da Dc Dx' smul gI

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. Dx a c (fst x) ∧ Dx' a c (f (gE a c (fst x))))

⟹ 𝗆𝖺𝗉 g ⊗f r : F1 a T ✼ R ↦ F1' a T' ✼ R'
    𝗈𝗏𝖾𝗋 f ⊗f w : F3a a (F3c c U) ✼ W ↦ F3a' a (F3c' c U') ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 apfst (gE a c) ` D

⟹ 𝗆𝖺𝗉 g ⊗f r : F1 a T ✼ R ↦ F1' a' T' ✼ R'
    𝗈𝗏𝖾𝗋 (gI a c o f o gE a c) ⊗f w : F3b b' U ✼ W ↦ F3b' b U' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o apfst (gE a c) 𝗌𝖾𝗍𝗍𝖾𝗋 apfst (gI a c) o s
      𝗂𝗇 D ›
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def
  apply (simp add: φProd_expn'' φProd_expn' )

❴ premises A and _ and SAE[] and [] and [] and [] and SAI[] and _ and Tr[]
  unfold ‹b' = b›
  apply_rule apply_Semimodule_SAssocE[where s=a and t=c, OF SAE, unfolded A]
  apply_rule ToA_Mapper_onward[OF Tr, where x=‹apfst (gE a c) x›]
❵ apply (rule conjunctionI, rule)
❴ premises A and _ and SAE[] and [] and [] and [] and SAI[] and _ and Tr[]
  unfold ‹a' = a›
  apply_rule ToA_Mapper_backward[OF Tr, where x=‹x›]
  apply_rule apply_Semimodule_SAssocI[where s=a and t=c, OF SAI, unfolded A]
  certified by (insert ToA_Mapper_f_expn[OF Tr], auto_sledgehammer)
❵ by (rule conjunctionI, rule, drule ToA_Mapper_f_expn, clarsimp, auto_sledgehammer)




subparagraph ‹With Parameterization›

(* TODO!
lemma SE_general_Semimodule_Scalar_left_b: (*need test, to be tested once we have usable test case*)
  ‹ 𝗀𝗎𝖺𝗋𝖽 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 smul a c = b)
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a ∧ Dc c
⟹ Functional_Transformation_FunctorΛ F14 F23 (T ∗[Cw] W) (F3c c U ∗[Cr] R) Dom Rng pred_mapper func_mapper
⟹ Module_AssocI F3a F3c F3b U Da Dc Dx smul gs
⟹ Separation_HomoI_Cond (F1 a) (F4 a) F14 Cw T W Dz z
⟹ Separation_HomoE_Cond (F3a a) (F2 a) F23 Cr (F3c c U) R Du uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Dz ∧ (∀a. a ∈ Dom (z x) ⟶ f a ∈ Rng (z x)) ∧
           func_mapper f P (z x) ∈ Du ∧
           Dx a c (fst (uz (func_mapper f P (z x))))
⟹ (⋀x ∈ Dom (z x). x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F3c c U ∗[Cr] R 𝗐𝗂𝗍𝗁 P x )
⟹ x ⦂ F1 a T ∗[Cw] F4 a W
    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst (gs a c) (uz (func_mapper f P (z x))) ⦂ F3b b U ∗[Cr] F2 a R
    𝗐𝗂𝗍𝗁 pred_mapper f P (z x) ›
  unfolding 𝗋Guard_def
  ❴ premises [simp] and _ and FTF and SA and SHI and SHE and _ and Tr
   ;; apply_rule apply_Separation_HomoI_Cond[OF SHI]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoE_Cond[OF SHE]
    apply_rule apply_Semimodule_SAssocI[OF SA, THEN transformation_right_frame_conditioned_ty]
  ❵ .
*)


subsection ‹Separation Extraction of Semimodule Left Distributivity›

paragraph ‹Commutative, Non-Unital Associative, No Additive Zero›

text ‹Non-unital algebra implies no additive zero.›

ML_file ‹library/phi_type_algebra/semimodule_rule_pass.ML›

(* [--d--][-----a-----]
   [-----b-----][--c--]
   Give a, expect b; Need d, remain c.
   d, c ≠ 0; the scalar has to be non-commutative, otherwise reduces to either ‹SE_Module_SDistr_da_b_i› or ‹SE_Module_SDistr_a_cb_i›
   as we assume non-commutative scalar, the concrete algebra must be commutative
*)
lemma SE_Module_SDistr_da_bc
      [φreason_template default %derived_SE_sdistr pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation d a b c)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx' z
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a ∧ Ds d ∧ Ds c ∧ Ds b
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Dx' d a (xd, fst x) ∧ Dx b c (z d a (xd, fst x))
⟹ (fst (uz b c (z d a (xd, fst x))), w) ⦂ F1 b ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ snd x ⦂ WW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (xd, w) ⦂ F1 d ∗ W @clean
⟹ (snd y, snd (uz b c (z d a (xd, fst x)))) ⦂ R ∗ F1 c 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 rr ⦂ RR @clean
⟹ x ⦂ F1 a ✼ WW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst y, rr) ⦂ F3 b ✼ RR 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
  for W :: ‹('c::sep_algebra,'d) φ› 
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
  apply (drule dabc_equation_D_main,
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric])
  ❴ premises SDU[] and SDZ[] and _ and _ and _ and Tr[] and C1[] and C2 and b[simp]
    C1
    apply_rule apply_Module_Distr_HomoZ[where s=d and t=a and F=F1 and x=‹(xd, fst x)›, OF SDZ]
    apply_rule apply_Module_Distr_HomoS[where s=b and t=c and F=F1, OF SDU]
    Tr
    C2
  ❵ .


(* [-----a-----][--d--]
   [--c--][-----b-----]
   Give a, expect b; Need d, remain c.
   d, c ≠ 0; the scalar has to be non-commutative, otherwise reduces to either ‹SE_Module_SDistr_da_b_i› or ‹SE_Module_SDistr_a_cb_i›
   as we assume non-commutative scalar, the concrete algebra must be commutative
*)
lemma SE_Module_SDistr_ad_cb
      [φreason_template default %derived_SE_sdistr pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation c b a d)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx' z
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a ∧ Ds d ∧ Ds c ∧ Ds b
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Dx' a d (fst x, fst xw) ∧ Dx c b (z a d (fst x, fst xw))
⟹ (snd (uz c b (z a d (fst x, fst xw))), snd xw) ⦂ F1 b ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ snd x ⦂ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 xw ⦂ F1 d ∗ W @clean
⟹ (fst (uz c b (z a d (fst x, fst xw))), snd y) ⦂ F1 c ∗ R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 r' ⦂ R' @clean
⟹ x ⦂ F1 a ✼ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst y, r') ⦂ F3 b ✼ R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
  for W :: ‹('c::sep_algebra,'d) φ›
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
  apply (drule dabc_equation_D_main;
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] )
  ❴ premises _ and _ and _ and [simp] and [simp] and Tr[] and C1[] and C2 and [simp]
    note φProd_expn''[simp] φProd_expn'[simp]
    ； C1
      apply_rule apply_Module_Distr_HomoZ[where s=a and t=d and F=F1 and x=‹(fst x, fst xw)›]
      apply_rule apply_Module_Distr_HomoS[where s=c and t=b and F=F1, simplified]
      Tr
      C2
  ❵ .



(* [---------a---------]
   [--d--][--b--][--c--]
   Give a, expect b, remain d, c.
   d, c ≠ 0; scalar has to be non-commutative; otherwise go ‹SE_Module_SDistr_a_cb_i›*) 
lemma SE_Module_SDistr_a_dbc
      [φreason_template default %derived_SE_sdistr+1]:
  ― ‹Boundary situations (when c or d equals zero) are captured here, so the rule has a higher priority
      than ‹SE_Module_SDistr_da_bc_nc_i› and ‹SE_Module_SDistr_ad_cb_nc_i› in order to preempt the
      boundary situations.›
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d b db c a)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cc ⟶ Ds c ∧ Ds db) ∧ (Cd ⟶ Ds d ∧ Ds b)
⟹ 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 x' : (snd (?sL Cd (uz d b) (fst (?sR Cc (uz db c) (fst x)))), snd x)
⟹ 𝗀𝗎𝖺𝗋𝖽 x' ⦂ F1 b ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ (⋀A w. 𝗀𝗎𝖺𝗋𝖽 𝗋Comm_Mul A (w ⦂ W))
⟹ (⋀x A. 𝗀𝗎𝖺𝗋𝖽 𝗋Comm_Mul (x ⦂ ◒[Cd] F1 d) A)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (Cc ⟶ Dx db c (fst x)) ∧ (Cd ⟶ Dx d b (fst (?sR Cc (uz db c) (fst x))))
⟹ (snd y, fst (?sL Cd (uz d b) (fst (?sR Cc (uz db c) (fst x)))), snd (?sR Cc (uz db c) (fst x))) ⦂ R ∗ ◒[Cd] F1 d ∗ ◒[Cc] F1 c
      𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 r ⦂ R' @clean
⟹ x ⦂ F1 a ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst y, r) ⦂ F3 b ✼ R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
  for R :: ‹('c::sep_monoid,'d) φ›
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
  ❴ premises [unfolded equation31_cond_def, simp] and SU[] and _ and _ and _ and Tr[] and swap1 and swap2 and _ and CC[]
    ； apply_rule apply_Module_Distr_HomoS_RCond[OF SU, where s=‹db› and t=c and r=a and C=Cc]
      apply_rule apply_Module_Distr_HomoS_LCond[OF SU, where s=‹d› and t=b and r=db and C=Cd]
      apply_rule 𝗋Comm_Mul.apply[OF swap2[where A=‹x ⦂ F1 b› for x]]
      apply_rule 𝗋Comm_Mul.apply[
            OF swap1[where A=‹(x ⦂ ◒[Cd] F1 d) * (y ⦂ ◒[Cc] F1 c)› for x y],
            THEN transformation_left_frame[where R=‹x ⦂ F1 b› for x]]
      Tr
      apply_rule CC[THEN transformation_left_frame[where R=‹x ⦂ F3 b› for x]]
  ❵ .


(* [--d--][--a--][--c--]
   [---------b---------]
   Give a, expect b, need d, c.
   d, c ≠ 0; scalar has to be non-commutative; otherwise go to ‹SE_Module_SDistr_da_b_i› *)
lemma SE_Module_SDistr_dac_b
      [φreason_template default %derived_SE_sdistr+1]:
  ― ‹Boundary situations (when c or d equals zero) are captured here, so the rule has a higher priority
      than ‹SE_Module_SDistr_da_bc_nc_i› and ‹SE_Module_SDistr_ad_cb_nc_i› in order to preempt the
      boundary situations.›
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d a da c b)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx z
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cd ⟶ Ds d ∧ Ds a) ∧ (Cc ⟶ Ds da ∧ Ds c)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (Cd ⟶ Dx d a (xd, fst x)) ∧
           (Cc ⟶ Dx da c (?jL Cd (z d a) (xd, fst x), xc))
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 x' : (?jR Cc (z da c) (?jL Cd  (z d a) (xd, fst x), xc), w)
⟹ x' ⦂ F1 b ✼ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ (⋀x A. 𝗀𝗎𝖺𝗋𝖽 𝗋Comm_Mul A (x ⦂ ◒[Cd] F1 d))
⟹ snd x ⦂ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (xd, xc, w) ⦂ ◒[Cd] F1 d ∗ ◒[Cc] F1 c ∗ W @clean
⟹ x ⦂ F1 a ✼ W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F3 b ✼ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
  for R :: ‹('c::sep_monoid,'d) φ›
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
  ❴ premises A[unfolded equation31_cond_def, simp] and _ and _ and _ and _ and _
         and Tr[] and swap1 and C1[]
    apply_rule C1[THEN transformation_left_frame[where R=‹fst x ⦂ F1 a›]]
    apply_rule 𝗋Comm_Mul.apply[OF swap1[where A=‹fst x ⦂ F1 a›]]
    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[where s=d and t=a and F=F1 and r=da and x=‹(xd, fst x)› and C=Cd]
    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[where s=da and t=c and F=F1 and x=‹(?jL Cd  (z d a) (xd, fst x), xc)› and C=Cc]
    Tr
  ❵ .


subsection ‹ToA mapper over Semimodules›

context notes prod_opr_norm[simp] φProd_expn''[simp] comp_assoc[symmetric, simp]
begin

(* [--d--][-----a-----]
   [-----b-----][--c--]
   Give a, expect b; Need d, remain c.
   d, c ≠ 0; the scalar has to be non-commutative, otherwise reduces to either ‹SE_Module_SDistr_da_b_i› or ‹SE_Module_SDistr_a_cb_i›
   as we assume non-commutative scalar, the concrete algebra must be commutative*)

lemma SE_Module_SDistr_da_bc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
          name F1.module_mapperda_bc
          pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ― ‹idk which one would be better. I perfer the former because,
      the getters are essentially identical, but the domain of the premises is simpler in the former›
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a ∧ b' = b ∧ c' = c
⟹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation d a b c)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dxu uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1' Ds' Dxu' uz'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz' z'
⟹ NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds d ∧ Ds a ∧ Ds b ∧ Ds c ∧ Ds' b ∧ Ds' c ∧ Ds' d ∧ Ds' a
― ‹TODO: ‹module_mapper22 True d a b c uz' z' uz z Dx' Dxu' Dx Dxu DM fc fb fa fd››

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀(xa,w,xd)∈D. let (y, yc) = uz b c (z d a (xd,xa))
                           in Dsz (xd,xa) (fb y, fc yc) ∧
                              Dxz d a (xd,xa) ∧
                              Dxu b c (z d a (xd,xa)) ∧
                              Dxz' b c (fb y, fc yc) ∧
                              Dxu' d a (z' b c (fb y, fc yc)) )

⟹ 𝗆𝖺𝗉 g ⊗f r : F3 b ✼ R ↦ F3' b ✼ R'
    𝗈𝗏𝖾𝗋 fb ⊗f w : F1 b ✼ W ↦ F1' b ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(xa,w,xd). case uz b c (z d a (xd,xa)) of (xb,xc) ⇒ (xb,w)) ` D

⟹ separatable_module_zip True d a b c uz' z' uz z Dsz fb fc fd fa @tag 𝒜_template_reason undefined

⟹ 𝗆𝖺𝗉 g ⊗f (r ⊗f fc) : F3 b ✼ R ∗ F1 c ↦ F3' b' ✼ R' ∗ F1' c'
    𝗈𝗏𝖾𝗋 fa ⊗f w ⊗f fd : F1 a ✼ W ∗ F1 d ↦ F1' a' ✼ W' ∗ F1' d
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(xa,w,xd). let (xb,xc) = uz b c (z d a (xd,xa))
                                 ; (y,r) = h (xb,w)
                                in (y,r,xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xc). let (xb,w) = s (y,r)
                                 ; (xd,xa) = uz' d a (z' b c (xb,xc))
                                in (xa,w,xd))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_algebra, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

  ❴ premises _ and A[THEN dabc_equation_D_main, simp] and _ and _ and _ and _ and _ and _ and Tr 
    apply_rule apply_Module_Distr_HomoZ[where t=a and s=d and F=F1 and x=‹case x of (xa,w,xd) ⇒ (xd,xa)›]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ ‹x ∈ D›]],
                  clarsimp split: prod.split simp add: useful(3-)) ；
    apply_rule apply_Module_Distr_HomoS[where t=c and s=b and F=F1]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ ‹x ∈ D›]],
                  clarsimp split: prod.split simp add: useful(3-)) ； ;;
    apply_rule ToA_Mapper_onward[OF Tr, where x=‹case x of (xa,w,xd) ⇒ case uz b c (z d a (xd,xa)) of (xb,xc) ⇒ (xb,w)›]
      certified by (clarsimp split: prod.split simp add: φ image_iff, insert φ(4), force)
  ❵ certified by (clarsimp split: prod.split)
    apply(rule conjunctionI, rule)
  ❴ premises _ and A[THEN dabc_equation_D_main] and _ and _ and _ and _ and _ and _ and Tr
    note A[THEN conjunct1, symmetric, simp]
         A[THEN conjunct2, simp] ；
    unfold ‹b' = b›
    unfold ‹c' = c› ；
    apply_rule ToA_Mapper_backward[OF Tr, where x=‹case x of (y,r,xc) ⇒ (y,r)›]
    certified by (insert useful(1), clarsimp split: prod.split simp add: φ image_iff,
                  case_tac ‹uz b c (z d a (ba, aa))›, clarsimp,
                  case_tac ‹h (ac,aaa)›, clarsimp, force) ；
    
    apply_rule apply_Module_Distr_HomoZ[where s=b and t=c and F=F1' and x=‹case x of (y,r,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xb,xc)›]
    certified apply (insert useful(1), simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                             ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: prod.rotL_def useful(3-) split: prod.split) . ；

    apply_rule apply_Module_Distr_HomoS[where s=d and t=a and F=F1' and x=‹case x of (y,r,xc) ⇒ case s (y,r) of (xb,w) ⇒ z' b c (xb,xc)›]
    certified apply (insert useful(1), simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                             ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: prod.rotL_def useful(3-) split: prod.split) . ;;
    fold ‹a' = a›
  ❵ certified by (clarsimp split: prod.split simp add: the_φ(16))
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
  subgoal premises prems for x proof -
    thm prems
      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 fb ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                     simplified, THEN bspec[OF _ ‹x ∈ D›]]
                      ‹separatable_module_zip _ _ _ _ _ _ _ _ _ _ _ _ _ _›
                            [unfolded separatable_module_zip_def, THEN spec[where x=‹case x of (xa,w,xd) ⇒ (xd,xa)›]],
            clarsimp split: prod.split simp: ‹dabc_equation d a b c› ‹a' = a› ‹b' = b› ‹c' = c›,
            insert prems(17) prems(20), fastforce)
    qed .



lemma SE_Module_SDistr_ad_cb_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
          name F1.module_mapperad_cb
          pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a ∧ b' = b ∧ c' = c
⟹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation c b a d)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dxu uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F3 F3'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1' Ds' Dxu' uz'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz' z'
⟹ NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a ∧ Ds d ∧ Ds c ∧ Ds b ∧ Ds' c ∧ Ds' b ∧ Ds' a ∧ Ds' d
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. let (xa,w,xd) = x
                    ; (xc,xb) = uz c b (z a d (xa,xd))
                   in Dsz (xa,xd) (fc xc, f xb) ∧
                      Dxz a d (xa,xd) ∧
                      Dxu c b (z a d (xa,xd)) ∧
                      Dxz' c b (fc xc, f xb) ∧
                      Dxu' a d (z' c b (fc xc, f xb)) )

⟹ 𝗆𝖺𝗉 g ⊗f r : F3 b ✼ R ↦ F3' b ✼ R'
    𝗈𝗏𝖾𝗋 f ⊗f w : F1 b ✼ W ↦ F1' b ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(xa,w,xd). let (xc,xb) = uz c b (z a d (xa,xd)) in (xb,w)) ` D

⟹ separatable_module_zip False a d c b uz' z' uz z Dsz fc f f' fd @tag 𝒜_template_reason undefined

⟹ 𝗆𝖺𝗉 g ⊗f (r ⊗f fc) : F3 b ✼ R ∗ F1 c ↦ F3' b' ✼ R' ∗ F1' c'
    𝗈𝗏𝖾𝗋 f' ⊗f w ⊗f fd : F1 a ✼ W ∗ F1 d ↦ F1' a' ✼ W' ∗ F1' d
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(xa,w,xd). let (xc,xb) = uz c b (z a d (xa,xd))
                                 ; (y,r) = h (xb,w)
                                in (y,r,xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xc). let (xb,w) = s (y,r)
                                 ; (xa,xd) = uz' a d (z' c b (xc,xb))
                                in (xa,w,xd))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_algebra, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def SIMP_def
            Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

  ❴ premises _ and dabc[THEN dabc_equation_D_main] and _ and _ and _ and _ and _ and _ and Tr and _ 
    note dabc[THEN conjunct1, symmetric, simp]
         dabc[THEN conjunct2, simp] ；

    apply_rule apply_Module_Distr_HomoZ[where s=a and t=d and F=F1]
      certified by (instantiate ‹(fst x, snd (snd x))›, clarsimp split: prod.split simp add: useful, insert useful(1,2), force) ;;
    apply_rule apply_Module_Distr_HomoS[where t=b and s=c and F=F1]
    apply_rule ToA_Mapper_onward[OF Tr, where x=‹case x of (xa,w,xd) ⇒ case uz c b (z a d (xa,xd)) of (xc,xb) ⇒ (xb,w)›]
      certified by (clarsimp split: prod.split simp add: useful)
  ❵ certified by (clarsimp split: prod.split simp add: useful)
    apply(rule conjunctionI, rule)
  ❴ premises _ and dabc[THEN dabc_equation_D_main, simp] and _ and _ and _ and _ and _ and _ and Tr
    unfold ‹b' = b›
    unfold ‹c' = c›
    apply_rule ToA_Mapper_backward[OF Tr, where x=‹case x of (y,r,xc) ⇒ (y,r)›]
    certified apply (clarsimp simp add: image_iff useful split: prod.split,
                     insert useful(1), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for x1 aa ba ab ac bb
                by (rule bexI[OF _ prems(2)], insert prems(1,3), clarsimp, case_tac ‹h (x2, ac)›, clarsimp) . ；

    apply_rule apply_Module_Distr_HomoZ[where s=c and t=b and F=F1' and x=‹case x of (y,r,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xc,xb)›]

    certified apply (insert useful(1)[simplified image_image], simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                    ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: useful(4-) split: prod.split) . ；

    apply_rule apply_Module_Distr_HomoS[where s=a and t=d and F=F1' and x=‹case x of (y,r,xc) ⇒ case s (y,r) of (xb,w) ⇒ z' c b (xc,xb)›]
    certified apply (insert useful(1)[simplified image_image], simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                    ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: useful(3-) split: prod.split) . ;;
    fold ‹a' = a›
  ❵ certified by (clarsimp split: prod.split simp add: the_φ(16))
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -

      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                     simplified, THEN bspec[OF _ ‹x ∈ D›]]
                      ‹separatable_module_zip _ _ _ _ _  _ _ _ _ _ _ _ _ _›[unfolded separatable_module_zip_def, THEN spec[where x=‹case x of (xa,w,xd) ⇒ (xa,xd)›]],
            clarsimp split: prod.split simp: ‹dabc_equation c b a d› ‹a' = a› ‹b' = b› ‹c' = c›,
            insert prems(17) prems(20), fastforce)
    qed .



lemma SE_Module_SDistr_a_dbc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_dbc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a ∧ b' = b
⟹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d b db c a)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz z

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cc ⟶ Ds c ∧ Ds db ∧ Ds' db ∧ Ds' c) ∧
                  (Cd ⟶ Ds d ∧ Ds b ∧ Ds' d ∧ Ds' b )
⟹ NO_SIMP (module_mapper31C Cc Cd c b db d uz z Dx Dxz DG fc f fd f' getter)

⟹ 𝗆𝖺𝗉 g ⊗f r : F3 b ✼ RG ↦ F3' b ✼ RG'
    𝗈𝗏𝖾𝗋 f ⊗f w : F1 b ✼ W  ↦ F1' b ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xd, xb, xc) ⇒ (xb, w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. DG (fst x))

⟹ 𝗆𝖺𝗉 g ⊗f r ⊗f fd ⊗f fc : F3 b ✼ RG ∗ ◒[Cd] F1 d ∗ ◒[Cc] F1 c ↦ F3' b' ✼ RG' ∗ ◒[Cd] F1' d ∗ ◒[Cc] F1' c
    𝗈𝗏𝖾𝗋 f' ⊗f w : F1 a ✼ W ↦ F1' a' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xd, xb, xc) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xd, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xd,xc). case s (y,r) of (xb,w) ⇒
                        (?jR Cc (z db c) (?jL Cd (z d b) (xd,xb), xc), w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_algebra, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def module_mapper31C_def
            Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

  ❴ premises _ and EC[unfolded equation31_cond_def, simplified, simp] and SS[] and SZ[] and _
         and MG and Tr[] and DG and Dom[useful]
    note DG' = DG[THEN bspec[OF _ Dom]]
    note t1[useful] = MG[THEN spec, THEN mp, OF DG'] ；

    apply_rule apply_Module_Distr_HomoS_RCond[OF SS, where s=‹db› and t=c and C=Cc]
    apply_rule apply_Module_Distr_HomoS_LCond[OF SS, where s=‹d› and t=b and C=Cd]

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=‹case x of (x,w) ⇒ case ?sR Cc (uz db c) x of (xdb, xc) ⇒ case ?sL Cd (uz d b) xdb of (xd, xb) ⇒ (xb, w)›]
      certified by (insert t1, clarsimp split: prod.split simp: image_iff, metis Dom fst_conv snd_conv)
      
  ❵ certified by (insert t1, clarsimp simp add: image_iff split: prod.split)
    apply (rule conjunctionI, rule)
  ❴ premises _ and EC[unfolded equation31_cond_def, simplified, simp] and SS[] and SZ[] and _
         and MG and Tr[] and DG and Dom'
    from Dom'
    obtain y where Dom[useful]: ‹y ∈ D›
               and x_def[simp]: ‹x = (g ⊗f r ⊗f fd ⊗f fc) (case y of (x, w) ⇒
                                              case getter x of (xd, xb, xc) ⇒ case h (xb, w) of (y, r) ⇒ (y, r, xd, xc))›
      by (clarsimp simp add: split_beta)
    note DG' = DG[THEN bspec[OF _ Dom]]
    note t1[useful] = MG[THEN spec, THEN mp, OF DG', THEN mp, OF EC[THEN conjunct2]] ;;

    unfold ‹b' = b›
    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apsnd fst x›]
    certified by (insert t1 Dom, clarsimp simp add: image_iff split: prod.split, force) ； ；

    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[OF SZ, where s=‹d› and t=b and r=db and C=Cd
                                                                and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xd,xb)›]
    certified by (insert useful(1) the_φ(6) ToA_Mapper_f_expn_rev[OF Tr],
                  clarsimp simp add: image_iff ‹Cd ⟶ _ ∧ _› split: prod.split,
                  fastforce) ；

    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[OF SZ, where s=‹db› and t=c and r=a and C=Cc
                                                             and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (?jL Cd (z d b) (xd,xb), xc)›]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified, THEN bspec[OF _ Dom]],
          clarsimp simp add: image_iff split: prod.split, auto_sledgehammer) ;;
    fold ‹a' = a›
  ❵ certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -

      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                            simplified, THEN bspec[OF _ ‹x ∈ D›]]
                      ‹∀x. DG x ⟶ _› [THEN spec[where x=‹fst x›]],
            clarsimp split: prod.split, auto_sledgehammer)
    qed .



lemma SE_Module_SDistr_a_dεc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_dεc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a
⟹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d ε dε c a )
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F1 U ε DεE Eε Any_PE
⟹ TERM Module_OneI F3 T ε DεIT IεT Any_PIT
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F1' U' ε DεI Iε Any_PI
⟹ TERM Module_OneE F3' T' ε DεET EεT Any_PET
⟹ NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cc ⟶ Ds c ∧ Ds dε ∧ Ds' dε ∧ Ds' c) ∧
                  (Cd ⟶ Ds d ∧ Ds ε ∧ Ds' d ∧ Ds' ε)
⟹ NO_SIMP (module_mapper3εC Cc Cd c ε dε d uz z Eε Iε DεE DεI Dx Dxz DG fc f fd f' getter)

⟹ 𝗆𝖺𝗉 g ⊗f r : T ✼ RG ↦ T' ✼ RG'
    𝗈𝗏𝖾𝗋 f ⊗f w : U ✼ W ↦ U' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xd, xb, xc) ⇒ (xb, w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. DG (fst x))

⟹ 𝗆𝖺𝗉 g ⊗f r ⊗f fd ⊗f fc : T ✼ RG ∗ ◒[Cd] F1 d ∗ ◒[Cc] F1 c ↦ T' ✼ RG' ∗ ◒[Cd] F1' d ∗ ◒[Cc] F1' c
    𝗈𝗏𝖾𝗋 f' ⊗f w : F1 a ✼ W ↦ F1' a' ✼ W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xd, xb, xc) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xd, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xd,xc). case s (y,r) of (xb,w) ⇒
                        (?jR Cc (z dε c) (?jL Cd (z d ε) (xd, Iε xb), xc), w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_algebra, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
            Type_Variant_of_the_Same_Scalar_Mul0_def module_mapper3εC_def
  apply simp

  ❴ premises _ and EC[unfolded equation31_cond_def, simp] and SS[] and SZ[] and S1E[] and [] and S1I[] and [] and _
         and MG and Tr[] and DG[] and Dom[useful]
    note DG' = DG[THEN bspec[OF _ Dom]]
    from EC have db: ‹?+ True dε = ?+ Cd d + ?+ True ε ∧ (Cc ⟶ dε ##+ c) ∧ (Cd ⟶ d ##+ ε)› by blast
    note t1[useful] = MG[THEN spec, THEN mp, OF DG', THEN mp, OF db] ；

    apply_rule apply_Module_Distr_HomoS_RCond[OF SS, where s=‹dε› and t=c and C=Cc]
    
    apply_rule apply_Module_Distr_HomoS_LCond[OF SS, where s=‹d› and t=ε and C=Cd]

    apply_rule apply_Module_OneE[OF S1E] ；

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=‹case x of (x,w) ⇒ case getter x of (xd, xb, xc) ⇒ (xb, w)›]
      certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff Let_def, auto_sledgehammer)

  ❵ certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff Let_def, auto_sledgehammer)
    apply (rule conjunctionI, rule)
  ❴ premises _ and EC[unfolded equation31_cond_def, simp] and SS[] and SZ[] and S1E[] and [] and S1I[] and [] and _
         and MG and Tr[] and DG[]  and Dom'[]
    from Dom'
    obtain y where Dom[useful]: ‹y ∈ D›
               and x_def[simp]: ‹x = (g ⊗f r ⊗f fd ⊗f fc) (
                        case y of (x, w) ⇒ case getter x of (xd, xb, xc) ⇒ case h (xb, w) of (y, r) ⇒ (y, r, xd, xc))›
      by (clarsimp simp add: split_beta)

    note DG' = DG[THEN bspec[OF _ Dom]]
    from EC have db: ‹?+ True dε = ?+ Cd d + ?+ True ε ∧ (Cc ⟶ dε ##+ c) ∧ (Cd ⟶ d ##+ ε)› by blast
    note t1[useful] = MG[THEN spec, THEN mp, OF DG', THEN mp, OF db] ;;

    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apsnd fst x›]
    certified by (insert t1 Dom, clarsimp simp add: image_iff split: prod.split, force) ;;

    apply_rule apply_Module_OneI[OF S1I]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp simp add: image_iff split: prod.split) ;;

    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[OF SZ, where s=‹d› and t=ε and r=dε and C=Cd
                                                                and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xd, Iε xb)›]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp simp add: image_iff split: prod.split, auto_sledgehammer) ;;

    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[OF SZ, where s=‹dε› and t=c and r=a and C=Cc
                                                             and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (?jL Cd (z d ε) (xd,Iε xb), xc)›]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp simp add: image_iff split: prod.split, auto_sledgehammer) ;;
    fold ‹a' = a›
  ❵ certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -
        show ?thesis
          by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                              simplified, THEN bspec[OF _ ‹x ∈ D›]]
                     ‹∀x. DG x ⟶ _› [THEN spec[where x=‹fst x›]],
              clarsimp split: prod.split, auto_sledgehammer)
      qed .

(* NOT MAINTAINED BUT DO NOT REMOVE, I am still not sure whether we can leave from conditioned
   split at all.
lemma SE_Module_SDistr_a_dεc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_dεc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 a = d + ε + c @tag 𝒜arith_eq)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds' Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F1 U ε DεE Eε Any_PE
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F1 U' ε DεI Iε Any_PI
⟹ NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds c ∧ Ds (d + ε) ∧ d + ε ##+ c ∧ Ds' (d + ε) ∧ Ds' c ∧
                  Ds d ∧ Ds ε ∧ Ds' d ∧ Ds' ε ∧ d ##+ ε
⟹ module_mapper3ε c ε d uz z Eε Iε DεE DεI Dx Dxz DG fc f fd f' getter @tag 𝒜_template_reason undefined

⟹ 𝗆𝖺𝗉 g ⊗f r : T ∗[CRG] RG ↦ T' ∗[CRG] RG'
    𝗈𝗏𝖾𝗋 f ⊗f w : U ∗[CW] W ↦ U' ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xc, xb, xd) ⇒ (xb, w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. Dsm (fst x) ∧ DG (fst x))

⟹ ◒[CR] R  = ◒[CRG] RG  ∗ ◒[True] F1 d ∗ ◒[True] F1 c @tag 𝒜merge
⟹ ◒[CR] R' = ◒[CRG] RG' ∗ ◒[True] F1 d ∗ ◒[True] F1 c @tag 𝒜merge

⟹ 𝗆𝖺𝗉 g ⊗f r ⊗f fd ⊗f fc : T ∗[CR] R ↦ T' ∗[CR] R'
    𝗈𝗏𝖾𝗋 f' ⊗f w : F1 a ∗[CW] W ↦ F1 a ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xc, xb, xd) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xd, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xd,xc). case s (y,r) of (xb,w) ⇒ (z c (d + ε) (xc, z ε d (Iε xb, xd)), w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_ab_semigroup, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def
            Type_Variant_of_the_Same_Scalar_Mul0_def module_mapper3ε_def
  apply (simp add: ToA_Mapper_φSome_rewr_origin;
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] Cond_φProd_expn_φSome)

  ❴ premises [simp] and SS[] and SZ[] and S1E[] and S1I[] and _ and A and Tr[] and _ and [] and []

    apply_rule apply_Module_Distr_HomoS_φSome[OF SS, where s=‹d+ε› and t=c]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;
    
    apply_rule apply_Module_Distr_HomoS_φSome[OF SS, where s=‹d› and t=ε]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule apply_Module_OneE_φSome[OF S1E]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=‹case x of (x,w) ⇒ case getter x of (xc, xb, xd) ⇒ (xb, w)›]
      certified by (insert A[THEN spec[where x=‹fst x›]]
                           useful(2) useful(3)[THEN bspec[OF _ useful(2)]],
                    clarsimp split: prod.split simp: image_iff Let_def, metis prod.inject)
  
  ❵ certified by (insert A[THEN spec[where x=‹fst x›]]
                         useful(3)[THEN bspec[OF _ ‹x ∈ D›]],
                  clarsimp simp add: image_iff Let_def split: prod.split)
    apply (rule conjunctionI, rule)
  ❴ premises _ and SS[] and SZ[] and S1E[] and S1I[] and _ and A and Tr[] and _ and [] and []

    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apsnd fst x›]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
    subgoal premises prems for a b
      by (insert useful(2)[THEN bspec[OF _ ‹_ ∈ D›]]
                 A[THEN spec[where x=‹a›]] prems,
          clarsimp simp: Let_def split: prod.split, force) . ;;

    apply_rule apply_Module_OneI_φSome[OF S1I]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for a b
                by (insert prems useful(2)[THEN bspec[OF _ prems(1)]]
                           ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ prems(1)]]
                           A[THEN spec[where x=‹a›]],
                    clarsimp simp: Let_def) . ;;

    apply_rule apply_Module_Distr_HomoZ_φSome[OF SZ, where s=‹d› and t=ε
                                                                and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (Iε xb,xd)›]
    certified apply (insert useful(2), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for a b
                by (insert useful(3)[THEN bspec[OF _ prems(1)]]
                           ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ prems(1)]]
                           A[THEN spec[where x=‹a›]],
                    insert prems, clarsimp simp: Let_def useful(4-), case_tac ‹h (Eε xaa, b)›, clarsimp) . ;;

    apply_rule apply_Module_Distr_HomoZ_φSome[OF SZ, where s=‹d+ε› and t=c
                                                            and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xc, z ε d (Iε xb,xd))›]
    certified apply (insert useful(2), clarsimp)
              subgoal premises prems for xa aa aaa ba ab bb
                by (insert prems ToA_Mapper_f_expn_rev[OF Tr, simplified, THEN bspec[OF _ ‹(ab, bb) ∈ D›]]
                           useful(3)[THEN bspec[OF _ ‹(ab, bb) ∈ D›]]
                           A[THEN spec[where x=‹ab›]],
                    clarsimp simp add: image_iff useful(4-) split: prod.split,
                    case_tac ‹h (Eε xaa, bb)›, clarsimp) .

  ❵ certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -
      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                            simplified, THEN bspec[OF _ ‹x ∈ D›]]
                      ‹∀x. DG x ⟶ _› [THEN spec[where x=‹fst x›]],
            clarsimp split: prod.split, auto_sledgehammer)
    qed .


lemma SE_Module_SDistr_a_εc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_εc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 a = ε + c @tag 𝒜arith_eq)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds' Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F1 U ε DεE Eε Any_PE
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F1 U' ε DεI Iε Any_PI
⟹ NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds c ∧ Ds ε ∧ ε ##+ c ∧ Ds' ε ∧ Ds' c
⟹ module_mapper2εR c ε uz z Eε Iε DεE DεI Dx Dxz DG fc f f' getter @tag 𝒜_template_reason None

⟹ 𝗆𝖺𝗉 g ⊗f r : T ∗[CRG] RG ↦ T' ∗[CRG] RG'
    𝗈𝗏𝖾𝗋 f ⊗f w : U ∗[CW] W ↦ U' ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xc, xb) ⇒ (xb, w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. Dsm (fst x) ∧ DG (fst x))

⟹ ◒[CR] R  = ◒[CRG] RG  ∗ ◒[True] F1 c @tag 𝒜merge
⟹ ◒[CR] R' = ◒[CRG] RG' ∗ ◒[True] F1 c @tag 𝒜merge

⟹ 𝗆𝖺𝗉 g ⊗f r ⊗f fc : T ∗[CR] R ↦ T' ∗[CR] R'
    𝗈𝗏𝖾𝗋 f' ⊗f w : F1 a ∗[CW] W ↦ F1 a ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xc, xb) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xc). case s (y,r) of (xb,w) ⇒ (z c ε (xc, Iε xb), w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_ab_semigroup, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def
            Type_Variant_of_the_Same_Scalar_Mul0_def module_mapper2εR_def
  apply (simp add: ToA_Mapper_φSome_rewr_origin;
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] Cond_φProd_expn_φSome)

  ❴ premises _ and SS[] and SZ[] and S1E[] and S1I[]and _ and A  and Tr[] and _ and [] and []

    apply_rule apply_Module_Distr_HomoS_φSome[OF SS, where s=‹ε› and t=c]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule apply_Module_OneE_φSome[OF S1E]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=‹case x of (x,w) ⇒ case getter x of (xc, xb) ⇒ (xb, w)›]
      certified by (insert A[THEN spec[where x=‹fst x›]]
                           useful(2) useful(3)[THEN bspec[OF _ useful(2)]]
                           A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: image_iff Let_def,
                    metis Pair_inject)
  ❵ certified by (insert A[THEN spec[where x=‹fst x›]]
                         useful(3)[THEN bspec[OF _ ‹x ∈ D›]],
                  clarsimp simp add: image_iff Let_def split: prod.split)
    apply (rule conjunctionI, rule)
  ❴ premises _ and SS[] and SZ[] and S1E[] and S1I[] and _ and A and Tr[] and _ and [] and []

    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apsnd fst x›]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
    subgoal premises prems for a b
      by (insert useful(2)[THEN bspec[OF _ ‹_ ∈ D›]]
                 A[THEN spec[where x=‹a›]]
                 prems,
          clarsimp simp: Let_def split: prod.split, force) . ;;

    apply_rule apply_Module_OneI_φSome[OF S1I]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for a b
                by (insert prems useful(2)[THEN bspec[OF _ prems(1)]]
                           ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ prems(1)]]
                           A[THEN spec[where x=‹a›]],
                    clarsimp simp: Let_def) . ;;

    apply_rule apply_Module_Distr_HomoZ_φSome[OF SZ, where s=‹ε› and t=c
                                                            and x=‹case x of (y,r,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xc, Iε xb)›]
    certified apply (insert useful(2), clarsimp)
              subgoal premises prems for xa a b aa ba
                by (insert prems ToA_Mapper_f_expn_rev[OF Tr, simplified, THEN bspec[OF _ ‹(aa, ba) ∈ D›]]
                           useful(3)[THEN bspec[OF _ ‹(aa, ba) ∈ D›]]
                           A[THEN spec[where x=‹aa›]],
                    clarsimp simp add: image_iff useful(4-) split: prod.split,
                    case_tac ‹h (Eε y, ba)›, clarsimp) .

  ❵ certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -
      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                            simplified, THEN bspec[OF _ ‹x ∈ D›]]
                   ‹∀x. DG x ⟶ _› [THEN spec[where x=‹fst x›]],
            clarsimp split: prod.split, auto_sledgehammer)
    qed .
*)


lemma SE_Module_SDistr_dac_b_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri name: F1.module_mapperdac_b]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a ∧ b' = b
⟹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d a da c b)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx z
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1' Ds' DxS uz
⟹ NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cd ⟶ Ds d ∧ Ds a ∧ Ds' d ∧ Ds' a) ∧
                  (Cc ⟶ Ds da ∧ Ds c ∧ Ds' da ∧ Ds' c)
⟹ module_mapper13C Cc Cd d a da c uz z DxS Dx DG fd fa fc f getter

⟹ 𝗆𝖺𝗉 g ⊗f r : F3 b ✼ R  ↦ F3' b ✼ R'
    𝗈𝗏𝖾𝗋 f ⊗f w : F1 b ✼ WG ↦ F1' b ✼ WG'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(xa,xd,xc,w). (getter (xa,xd,xc), w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀(xa,xd,xc,w)∈D. DG (xa,xd,xc))

⟹ 𝗆𝖺𝗉 g ⊗f r : F3 b ✼ R ↦ F3' b' ✼ R'
    𝗈𝗏𝖾𝗋 fa ⊗f fd ⊗f fc ⊗f w : F1 a' ✼ ◒[Cd] F1 d ∗ ◒[Cc] F1  c ∗ WG ↦ F1' a' ✼ ◒[Cd] F1' d ∗ ◒[Cc] F1' c ∗ WG'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(xa,xd,xc,w). h (getter (xa,xd,xc), w))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λyr. let (xb,w) = s yr
                           ; (xda,xc) = ?sR Cc (uz da c) xb
                           ; (xd,xa) = ?sL Cd (uz d a) xda
                          in (xa,xd,xc,w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_algebra, 'a) φ›
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

  ❴ premises [simp] and EC[unfolded equation31_cond_def, simp] and SZ[] and [] and [simp]
         and MG and Tr[] and DG[] and Dom
    from DG[THEN bspec[OF _ Dom]]
    have DG': ‹DG (case x of (xa, xd, xc, w) ⇒ (xa, xd, xc))› by (cases x; clarsimp)
    note t1[useful] = MG[unfolded module_mapper13C_def, THEN spec, THEN mp, OF DG', THEN mp, OF EC[THEN conjunct2]] ;;

    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[OF SZ, where s=d and t=a and r=da and C=Cd
                                                                  and x=‹case x of (xa,xd,xc,w) ⇒ (xd,xa)›]
    certified by (insert t1 Dom, clarsimp split: prod.split) ;;
      
    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[OF SZ, where s=da and t=c and r=b and C=Cc
                                                                  and x=‹case x of (xa,xd,xc,w) ⇒ (?jL Cd (z d a) (xd,xa), xc)›]
    certified by (insert t1 Dom, clarsimp split: prod.split) ;;

    apply_rule ToA_Mapper_onward[OF Tr, where x=‹case x of (xa,xd,xc,w) ⇒ (?jR Cc (z da c) (?jL Cd (z d a) (xd,xa), xc), w)›]
    certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff, auto_sledgehammer)
  ❵ certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff)
    apply (rule conjunctionI, rule)
  ❴ premises _ and EC[unfolded equation31_cond_def, simp] and SZ[] and SS[] and B
         and MG and Tr[] and DG[] and Dom'[]

    from Dom'
    obtain y where Dom[useful]: ‹y ∈ D›
               and x_def[simp]: ‹x = (g ⊗f r) (case y of (xa, xd, xc, w) ⇒ h (getter (xa, xd, xc), w))›
      by (clarsimp, metis map_prod_simp)

    from DG[THEN bspec[OF _ Dom]]
    have DG': ‹DG (case y of (xa, xd, xc, w) ⇒ (xa, xd, xc))› by (cases x; clarsimp)
    note t1[useful] = MG[unfolded module_mapper13C_def, THEN spec, THEN mp, OF DG', THEN mp, OF EC[THEN conjunct2]] ;;

    unfold ‹b' = b›
    apply_rule ToA_Mapper_backward[OF Tr, where x=x]
    certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff, force) ；

    apply_rule apply_Module_Distr_HomoS_RCond[OF SS, where x=‹(fst o s) x› and s=da and t=c and r=b and C=Cc]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp split: prod.split simp: image_iff B) ；

    apply_rule apply_Module_Distr_HomoS_LCond[OF SS, where s=d and t=a and r=da and C=Cd and x=‹(fst o ?sR Cc (uz da c) o fst o s) x›]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                 clarsimp split: prod.split simp: image_iff B) ;;
    fold ‹a' = a›
  ❵ certified by (clarsimp split: prod.split simp: prod.map_beta the_φ(10))
    apply (rule conjunctionI, rule, rule, unfold Premise_def conj_imp_eq_imp_imp module_mapper13C_def)
  subgoal premises prems for x proof -
    from ‹∀(xa, xd, xc, w)∈D. DG (xa, xd, xc)›[THEN bspec[OF _ ‹x ∈ D›]]
    have DG': ‹DG (case x of (xa, xd, xc, w) ⇒ (xa, xd, xc))› by (cases x; clarsimp)

    show ?thesis
      by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                          simplified, THEN bspec[OF _ ‹x ∈ D›]]
                 ‹∀x. DG x ⟶ _›[THEN spec, THEN mp, OF DG'],
          cases x, clarsimp split: prod.split,
          case_tac ‹?sR Cc (uz da c) (f (?jR Cc (z da c) (?jL Cd (z d a) (b, aa), ca)))›, clarsimp,
          case_tac ‹?sL Cd (uz d a) x1›, clarsimp,
          insert equation31_cond_def prems(3), fastforce)
  qed .

end



subsection ‹Commutativity between φ-Type Operators›

paragraph ‹Deriving Rewrites›

(*TODO Tyops_Commute1_2*)

subparagraph ‹1-to-1›

lemma Comm_Tyops_Rewr_temlpate[φreason_template name F.G.rewr[]]:
  ‹ Tyops_Commute F F' G G' T D (embedded_func f P)
⟹ Tyops_Commute G' G F' F T D' (embedded_func g Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (g (f x) = x) ∧ D x ∧ D' (f x)
⟹ (x ⦂ F (G T)) = (f x ⦂ G' (F' T)) ›
  unfolding Tyops_Commute_def Premise_def Transformation_def BI_eq_iff
  by clarsimp metis

lemma Comm_Tyops_Rewr2_temlpate[φreason_template name F.G.rewr[]]:
  ‹ Tyops_Commute1_2 F F'T F'U G G' T U D (embedded_func f P)
⟹ Tyops_Commute2_1 F F'T F'U G G' T U D' (embedded_func g Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 g (f x) = x ∧ D x ∧ D' (f x)
⟹ (x ⦂ F (G T U)) = (f x ⦂ G' (F'T T) (F'U U)) ›
  unfolding BI_eq_iff Premise_def Tyops_Commute1_2_def Tyops_Commute2_1_def Transformation_def
  by clarsimp metis

subparagraph ‹1-to-1λ›

lemma [φreason_template name F.G.rewr[]]:
  ‹ Tyops_CommuteΛI F F' G G' T D  (embedded_func f P)
⟹ Tyops_CommuteΛE G' G F' F T D' (embedded_func g Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ∧ D' (f x) ∧ g (f x) = x
⟹ (x ⦂ F (G T)) = (f x ⦂ G' (λp. F' (T p))) ›
  unfolding Tyops_CommuteΛI_def Tyops_CommuteΛE_def Transformation_def Premise_def BI_eq_iff
  by clarsimp metis

lemma [φreason_template name F.G.rewr[]]:
  ‹ Tyops_CommuteΛE F F' G G' T D  (embedded_func f P)
⟹ Tyops_CommuteΛI G' G F' F T D' (embedded_func g Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ∧ D' (f x) ∧ g (f x) = x
⟹ (x ⦂ F (λp. G (T p))) = (f x ⦂ G' (F' T)) ›
  unfolding Tyops_CommuteΛI_def Tyops_CommuteΛE_def Transformation_def Premise_def BI_eq_iff
  by clarsimp metis

subparagraph ‹1-to-2›

lemma [φreason_template name F.G.rewr[]]:
  ‹ Tyops_Commute1_2 F F'T F'U G G' T U D  (embedded_func f P)
⟹ Tyops_Commute2_1 F F'T F'U G G' T U D' (embedded_func g Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ∧ D' (f x) ∧ g (f x) = x
⟹ (x ⦂ F (G T U)) = (f x ⦂ G' (F'T T) (F'U U)) ›
  unfolding Tyops_Commute2_1_def Tyops_Commute1_2_def Premise_def Transformation_def
            BI_eq_iff
  by clarsimp metis

lemma [φreason_template name G'.F.rewr[]]:
  ‹ Tyops_Commute1_2 F F'T F'U G G' T U D  (embedded_func f P)
⟹ Tyops_Commute2_1 F F'T F'U G G' T U D' (embedded_func g Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (g x) ∧ D' x ∧ f (g x) = x
⟹ (x ⦂ G' (F'T T) (F'U U)) = (g x ⦂ F (G T U)) ›
  unfolding Tyops_Commute2_1_def Tyops_Commute1_2_def Premise_def Transformation_def
            BI_eq_iff
  by clarsimp metis


paragraph ‹Deriving ToA›

subparagraph ‹1-to-1›

lemma [φreason_template name F.G.comm[no_atp]]:
  ‹ Tyops_Commute F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (r, RE) = (embedded_func f P, (x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ G' (F' T) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) ∨cut
    RE = (x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫)
    @tag 𝒜_template_reason undefined
⟹ RE ›
  unfolding Premise_def Action_Tag_def Tyops_Commute_def Orelse_shortcut_def
  by (elim disjE; simp)

subparagraph ‹1-to-1λ›

lemma [φreason_template name F.G.comm[no_atp]]:
  ‹ Tyops_CommuteΛI F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (r, RE) = (embedded_func f P, (x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ G' (λp. F' (T p)) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) ∨cut
    RE = (x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
⟹ RE ›
  unfolding Premise_def Action_Tag_def Tyops_CommuteΛI_def Orelse_shortcut_def Transformation_def
  by (elim disjE; simp)

lemma [φreason_template name F.G.comm[no_atp]]:
  ‹ Tyops_CommuteΛE F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (r, RE) = (embedded_func f P, (x ⦂ F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ G' (F' T) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) ∨cut
    RE = (x ⦂ F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
⟹ RE ›
  unfolding Premise_def Action_Tag_def Tyops_CommuteΛE_def Orelse_shortcut_def Transformation_def
  by (elim disjE; simp)


subparagraph ‹1-to-2›

lemma Comm_Tyops1_2_ToA_temlpate[φreason_template name F.G.comm[no_atp]]:
  ‹ Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (r, RE) = (embedded_func f P, (x ⦂ F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ G' (F'T T) (F'U U) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) ∨cut
    RE = (x ⦂ F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
⟹ RE ›
  unfolding Premise_def Action_Tag_def Tyops_Commute1_2_def Orelse_shortcut_def
  by (elim disjE; simp)

lemma Comm_Tyops2_1_ToA_temlpate[φreason_template name F.G.comm[no_atp]]:
  ‹ Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (r, RE) = (embedded_func f P, (x ⦂ G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F (G T U) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) ∨cut
    RE = (x ⦂ G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
⟹ RE ›
  unfolding Premise_def Action_Tag_def Tyops_Commute2_1_def Orelse_shortcut_def
  by (elim disjE; simp )


paragraph ‹Swapping Normalization›

subparagraph ‹1-to-1›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (⋀y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
⟹ x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_transitive_simp ›
  unfolding Transformation_def Action_Tag_def Tyops_Commute_def Premise_def
            Simplify_def Action_Tag_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (⋀y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
⟹ x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_backward_transitive_simp ›
  unfolding Transformation_def Action_Tag_def Tyops_Commute_def Premise_def
            Simplify_def Action_Tag_def 𝗋Guard_def
  by clarsimp

paragraph ‹1-to-2›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (⋀y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
⟹ x ⦂ F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_transitive_simp ›
  unfolding Tyops_Commute1_2_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (⋀y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
⟹ x ⦂ G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (G T U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_backward_transitive_simp ›
  unfolding Tyops_Commute2_1_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

paragraph ‹2-to-1›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (⋀y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
⟹ x ⦂ G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (G T U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_transitive_simp ›
  unfolding Tyops_Commute2_1_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (⋀y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
⟹ x ⦂ F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_backward_transitive_simp ›
  unfolding Tyops_Commute1_2_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

paragraph ‹‹Λ››

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  ‹ Tyops_CommuteΛI F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_transitive_simp ›
  unfolding Tyops_CommuteΛI_def Action_Tag_def Tyops_Commute_def Premise_def
  by clarsimp

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_CommuteΛE F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_transitive_simp ›
  unfolding Tyops_CommuteΛE_def Action_Tag_def Tyops_Commute_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_CommuteΛI F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_backward_transitive_simp ›
  unfolding Tyops_CommuteΛI_def Action_Tag_def Tyops_Commute_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_CommuteΛE F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_backward_transitive_simp ›
  unfolding Tyops_CommuteΛE_def Action_Tag_def Tyops_Commute_def Premise_def 𝗋Guard_def
  by clarsimp


paragraph ‹Bubbling›

subparagraph ‹1-to-1›

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp ›
  unfolding Tyops_Commute_def Premise_def Action_Tag_def Bubbling_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp›
  unfolding Tyops_Commute_def Premise_def Bubbling_def Transformation_def Action_Tag_def 𝗋Guard_def
  by clarsimp


subparagraph ‹1-to-2›

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp ›
  unfolding Tyops_Commute1_2_def Premise_def Action_Tag_def Bubbling_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling+1]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp›
  unfolding Tyops_Commute1_2_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp›
  unfolding Tyops_Commute1_2_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp›
  unfolding Tyops_Commute1_2_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp


subparagraph ‹2-to-1›

lemma [φreason_template default %φsimp_derived_bubbling+1]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp ›
  unfolding Tyops_Commute2_1_def Premise_def Action_Tag_def Bubbling_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
    <except-pattern> x ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY @tag 𝒜simp ›
  unfolding Tyops_Commute2_1_def Premise_def Action_Tag_def Bubbling_def Except_Pattern_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ G' (F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
    <except-pattern> x ⦂ G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY @tag 𝒜simp ›
  unfolding Tyops_Commute2_1_def Premise_def Action_Tag_def Bubbling_def Except_Pattern_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp›
  unfolding Tyops_Commute2_1_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp


subparagraph ‹1-to-1λ›

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ Tyops_CommuteΛI F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (x ⦂ F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y) @tag 𝒜simp ›
  unfolding Tyops_CommuteΛI_def Premise_def Bubbling_def Action_Tag_def Simplify_def
  by simp

lemma [φreason_template default %φsimp_derived_bubbling]:
  ‹ Tyops_CommuteΛE F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ (x ⦂ F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y) @tag 𝒜simp ›
  unfolding Tyops_CommuteΛE_def Premise_def Bubbling_def Action_Tag_def Simplify_def
  by simp


paragraph ‹To-Transformation Interpreter›

lemma [φreason_template default %To_ToA_derived]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 F G) ›
  unfolding Tyops_Commute_def Premise_def Action_Tag_def Except_Pattern_def Simplify_def 𝗋Guard_def
  by clarsimp


section ‹Property Derivers›

subsection ‹Extension of BNF-FP›

ML_file ‹library/phi_type_algebra/tools/BNF_fp_sugar_more.ML›
ML_file ‹library/phi_type_algebra/tools/extended_BNF_info.ML›



subsection ‹Deriver Framework›

consts φTA_subgoal :: ‹action ⇒ action›
       φTA_ANT :: action ― ‹Antecedent in the outcome›
       φTA_conditioned_ToA_template :: action
       φTA_pure_facts :: action ― ‹About ‹φTA_conditioned_ToA_template› and ‹φTA_pure_facts›,
                                    see comments in 🗏‹library/phi_type_algebra/deriver_framework.ML›
                                    ML function ‹default_reasoning_configure››
       φTA_ToA_elim :: action

definition ‹φTA_IND_TARGET T = T›

lemmas intro_φTA_ANT = Action_Tag_def[where A=‹φTA_ANT›, symmetric, THEN Meson.TruepropI]

lemma mk_ToA_rule:
  ‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 Q ∧ P @tag 𝒯𝒫›
  using transformation_trans Action_Tag_def
  by blast

lemma mk_ToA_rule':
  ‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q ∧ P @tag 𝒯𝒫›
  unfolding REMAINS_def Action_Tag_def
  by (simp add: transformation_right_frame transformation_trans)

lemma mk_ToA_rule_varified:
  ‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x' ⦂ T 𝗐𝗂𝗍𝗁 P
⟹ Object_Equiv T eq
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 eq x' x ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq x' x
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗐𝗂𝗍𝗁 Q ∧ P @tag 𝒯𝒫›
  unfolding Premise_def Object_Equiv_def Transformation_def Action_Tag_def
  by clarsimp blast

lemma mk_ToA_rule'_varified:
  ‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x' ⦂ T 𝗐𝗂𝗍𝗁 P
⟹ Object_Equiv T eq
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 eq x' x ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq x' x
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q ∧ P @tag 𝒯𝒫›
  unfolding REMAINS_def Premise_def Object_Equiv_def Transformation_def Action_Tag_def
  by (clarsimp; blast)


lemma [fundef_cong]:
  ‹T x = T' x' ⟹ (x ⦂ T) = (x' ⦂ T')›
  unfolding φType_def by simp

lemma φTA_ind_target_strip:
  ‹ X @tag φTA_subgoal 𝒜 ≡ X @tag 𝒜 ›
  unfolding Action_Tag_def .

(*TODO: rename Action_Tag ⟶ Reasoning_Tag, @tag → @tag*)

lemma φTA_common_rewr_imp1:
  ‹ Trueprop (Ant ⟶ X @tag φTA_subgoal A) ≡ (Ant ⟹ X @tag A) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp1_noact:
  ‹ Trueprop (Ant ⟶ X @tag φTA_subgoal A) ≡ (Ant ⟹ X) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp1_rev:
  ‹ (Ant ⟹ X @tag A) ≡ Trueprop (Ant ⟶ X @tag A) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2:
  ‹ Trueprop (Ant ⟶ C ⟶ X @tag φTA_subgoal 𝒜)
 ≡ (Ant ⟹ C ⟹ X @tag 𝒜) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2':
  ‹ Trueprop (Ant ⟶ Q ⟶ P @tag φTA_subgoal 𝒜)
 ≡ (Ant ⟹ Q ⟶ (P @tag 𝒜)) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2_rev:
  ‹ (Ant ⟹ C ⟹ X @tag 𝒜) ≡ Trueprop (Ant ⟶ C ⟶ X @tag 𝒜) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2_noact:
  ‹ Trueprop (Ant ⟶ C ⟶ X @tag φTA_subgoal A)
 ≡ (Ant ⟹ C ⟹ X) ›
  unfolding Action_Tag_def atomize_imp .

lemma φTA_reason_rule__simp:
  ‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X' 𝗐𝗂𝗍𝗁 Any' @tag 𝒜_apply_simplication
⟹ X' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒜simp›
  unfolding Action_Tag_def
  by (simp add: Transformation_def)

lemma φTA_reason_rule__𝒜_simp:
  ‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X' 𝗐𝗂𝗍𝗁 Any @tag 𝒜_map_each_item A
⟹ X' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X'' 𝗐𝗂𝗍𝗁 Any' @tag 𝒜_apply_simplication
⟹ X'' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag A›
  unfolding Action_Tag_def
  by (simp add: Transformation_def)

lemma elim_TA_ANT:
  ‹ ((PROP A ⟹ PROP C) ⟹ PROP A ⟹ PROP B) ≡ (PROP A ⟹ PROP C ⟹ PROP B) ›
  apply rule
  subgoal premises prems by (rule prems(1), rule prems(3), rule prems(2))
  subgoal premises prems by (rule prems(1), rule prems(3), rule prems(2), rule prems(3)) .


ML_file ‹library/phi_type_algebra/deriver_framework.ML›

consts φderiver_expansion :: mode

φreasoner_ML φderiver_expansion %cutting
  (‹Premise φderiver_expansion _› | ‹Simplify φderiver_expansion ?X' ?X› )
  = ‹Phi_Reasoners.wrap (PLPR_Simplifier.simplifier (K Seq.empty)
        Phi_Type_Derivers.equip_expansion_ss0 {fix_vars=true}) o snd›


subsection ‹Extending Property Guessers›

text ‹When derivers provide gussers of specific strategies typically based on the logic types of the
  abstract domain, boolean constraints implies inside can in addition augment the guessing.
  The section aims to provide a general mechanism syntactically extracting the constraints.

  The extraction works in two modes,
  ▪ covariant, where the boolean constraints are proof obligations have to be shown, and the φ-type
      typically locates at the right hand side of a transformation;
  ▪ contra-variant, where the constraints are conditions constraining the proof obligations, and the
      φ-type typically locates at the left hand side of a transformation.
›



  ― ‹A general mechanism to provide user heuristics which guesses the entire property
      of some specific forms of φ-types›

text ‹When guessing the property, the system first tries to see if there is any user overridings
  by ‹Guess_Property› reasoning which gives the desired property entirely, if not, it goes to the normal
  guesser procedure implemented by each deriver, and after obtaining the guessed property,
  the system runs the ‹Guess_Property› again with the ‹guessed_conclusion› setting to None to force
  guessing the antecedents only, in this way to refine the already guessed antecedent either by
  adding new antecedents or constraining the antecedents by conditions.›

type_synonym variant = bool ―‹True for covariant, False for contravariant, undefined for invariant›

definition Guess_Property :: ‹'property_const ⇒ variant ⇒ ('c,'a) φ ⇒ ('c,'a) φ ⇒ bool ⇒ ('a ⇒ bool) ⇒ ('a ⇒ bool) ⇒ bool›
  where ‹Guess_Property the_constant_of_the_property_predicate ― ‹gives which sort of properties we are guessing›
                        variantness_of_the_property
                        original_φtype unfolded_φtype
                        guessed_antecedents guessed_proof_obligation yielded_conditions
          ≡ True›
(*
definition Guess_Property :: ‹'property_const ⇒ variant ⇒ 'a BI ⇒ bool ⇒ bool ⇒ bool option ⇒ bool›
  where ‹Guess_Property the_constant_of_the_property_predicate
                        variantness_of_the_property
                        unfolded_φtype_definition
                        guessed_antecedents
                        conditions_of_antecedents
                        guessed_conclusion ― ‹None for the mode guessing antecedents only›
          ≡ True›
*)
declare [[
  φreason_default_pattern ‹Guess_Property ?PC ?V ?T ?uT _ _ _› ⇒
                          ‹Guess_Property ?PC ?V ?T ?uT _ _ _› (100)
]]

φreasoner_group φTA_guesser = (100, [80, 2999]) for ‹Guess_Property PC V T uT a pa cond›
    ‹User heuristics overriding or extending the guesser mechanism of φtype derivers.›
 and φTA_guesser_init = (3000, [3000, 3000]) for ‹Guess_Property PC V T uT a pa cond› > φTA_guesser
    ‹Initializing the Guessing›
 and φTA_guesser_default = (30, [2, 79]) for ‹Guess_Property PC V T uT a pa cond› < φTA_guesser
    ‹Default rules handling logical connectives›
 and φTA_guesser_assigning_variant = (2200, [2200,2200]) for ‹Guess_Property PC V T uT a pa cond›
                                                          in φTA_guesser and > φTA_guesser_default
    ‹Fallbacks using common default rules›
 and φTA_guesser_fallback = (1,[1,1]) for ‹Guess_Property PC V T uT a pa cond› < φTA_guesser_default
    ‹Fallbacks of Guess_Property›
                
ML_file ‹library/phi_type_algebra/guess_property.ML›

paragraph ‹System Rules›

lemma [φreason default %φTA_guesser_fallback]:
  ‹Guess_Property PC V T T' True (λ_. True) (λ_. True)›
  unfolding Guess_Property_def ..

lemma [φreason default %φTA_guesser_init]:
  ‹(⋀x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_T' x) : (x ⦂ T) )
⟹ Guess_Property PC V T var_T' a p c
⟹ Guess_Property PC V T var_T' a p c ›
  unfolding Guess_Property_def ..

paragraph ‹Preset›

lemma [φreason default %φTA_guesser_default]:
  ‹ Guess_Property PC False T A a p c
⟹ Guess_Property PC False T (λx. A x 𝗌𝗎𝖻𝗃 P x) a p (λx. P x ∧ c x) ›
  ‹ (⋀c. Guess_Property PC False T (λx. A' x c) (a' c) (p' c) (cond c))
⟹ Guess_Property PC False T (λx. ExBI (A' x)) (All a') (λx. ∀c. p' c x) (λx. ∃c. cond c x)›
  unfolding Guess_Property_def ..

lemma [φreason default %φTA_guesser_default]:
  ‹ Guess_Property PC True T A a p c
⟹ Guess_Property PC True T (λx. A x 𝗌𝗎𝖻𝗃 P x) a (λx. P x ∧ p x) c ›
  ‹ (⋀c. Guess_Property PC True T (λx. A' x c) (a' c) (c' c) (cond c))
⟹ Guess_Property PC True T (λx. ExBI (A' x)) (Ex a') (λx. ∃c. c' c x) (λx. ∀c. cond c x) ›
  unfolding Guess_Property_def ..

lemma [φreason %φTA_guesser_default]:
  ‹ Guess_Property PC V T A a1 p1 c1
⟹ Guess_Property PC V T B a2 p2 c2
⟹ Guess_Property PC V T (λx. A x * B x) (a1 ∧𝗋 a2) (λx. p1 x ∧ p2 x) (λx. c1 x ∧ c2 x)›
  unfolding Guess_Property_def ..


subsection ‹Simplify Result›

definition Simplify_Result :: ‹prop ⇒ prop ⇒ prop› where ‹Simplify_Result P Q ≡ (PROP P ⟹ PROP Q)›

lemma DO_Simplify_Result:
  ‹ PROP P
⟹ PROP Simplify_Result P Q
⟹ 𝗋Success
⟹ PROP Q ›
  unfolding Simplify_Result_def .

text ‹Simplifies only naked conditions (in sens of not wrapped by ‹⋀› or ‹⟹›) but not arbitrary antecedents›

paragraph ‹Basic Rules›

lemma
  ‹ PROP 𝒜EIF' A A'
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 A' ⟹ PROP Simplify_Result (PROP B) (PROP B'))
⟹ PROP Simplify_Result (PROP A ⟹ PROP B) (PROP A ⟹ PROP B') ›
  unfolding Simplify_Result_def Premise_def 𝒜EIF'_def
  subgoal premises prems
    by (rule prems(2), rule prems(1), rule prems(4), rule prems(3), rule prems(4)) .
    



subsection ‹Warn if the Def contains Sat›

φproperty_deriver Warn_if_contains_Sat 10 = ‹fn (quiet, _) => fn [] => fn phi => fn thy => (
  if Phi_Syntax.is_nonnull_Type_Opr (Term.fastype_of (#term phi)) andalso
     Phi_Type.def_contains_satisfaction phi andalso
     not quiet
  then warning ("The φ-type definition contains satisfaction operator (⊨).\n\
                \When a φ-type is specified by satisfaction in a boolean assertion, it looses the ability to guide the reasoning.\n\
                \The deriving may fail. It is recommended to use composition operator (⨾) to replace the (⊨) if possible.")
  else () ;
  thy
)›


subsection ‹Meta Deriver for Pure Syntactical Properties›

ML_file ‹library/phi_type_algebra/gen_pure_synt_rules.ML›

φproperty_deriver Semimodule_No_SDistr 100
    = ‹Phi_Type_Derivers.meta_Synt_Deriver
          ("Semimodule_No_SDistr",
           @{lemma' ‹Semimodule_No_SDistr F› by (simp add: Semimodule_No_SDistr_def)},
           SOME (@{reasoner_group %Semimodule_No_SDistr})) ›


subsection ‹Abstract Domain›

context begin

private lemma φTA_Inh_rule:
  ‹ (⋀x. Ant ⟹ (x ⦂ OPEN undefined T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P x) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Abstract_Domain T P›
  unfolding Action_Tag_def Abstract_Domain_def OPEN_def 𝗋EIF_def
  by simp

private lemma φTA_SuC_rule:
  ‹ (⋀x. Ant ⟹ (P x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ MAKE undefined T) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Abstract_DomainL T P›
  unfolding Action_Tag_def Abstract_DomainL_def MAKE_def 𝗋ESC_def
  by simp

private lemma φTA_Inh_step:
  ‹ Inh 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Any
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (Any ⟶ P)
⟹ Inh 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P ›
  unfolding Action_Tag_def Premise_def 𝗋EIF_def
  by blast

private lemma φTA_Suc_step:
  ‹ Any 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 Inh
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (P ⟶ Any)
⟹ P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 Inh ›
  unfolding Action_Tag_def Premise_def 𝗋ESC_def
  by blast

private lemma φTA_Inh_rewr_IH:
  ‹ Trueprop (Ant ⟶ (x ⦂ OPEN undefined T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) @tag φTA_subgoal A)
 ≡ (Ant ⟹ (x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P)) ›
  unfolding Action_Tag_def atomize_imp OPEN_def .

private lemma φTA_Suc_rewr_IH:
  ‹ Trueprop (Ant ⟶ (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ MAKE undefined T) @tag φTA_subgoal A)
 ≡ (Ant ⟹ (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ MAKE undefined T)) ›
  unfolding Action_Tag_def atomize_imp OPEN_def .


ML_file ‹library/phi_type_algebra/implication.ML›

end

(*hide_fact φTA_Inh_rule φTA_Inh_rewr φTA_Inh_step*)

φproperty_deriver Abstract_DomainL 89 for ( ‹Abstract_DomainL _ _› ) = ‹
  Phi_Type_Derivers.abstract_domain_L
›

φproperty_deriver Abstract_Domain 90 for ( ‹Abstract_Domain _ _› )  = ‹
  Phi_Type_Derivers.abstract_domain
›



subsection ‹Identity Element Intro \& Elim›

context begin

private lemma φTA_1L_rule:
  ‹ (⋀x. Ant ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟹ Identity_ElementI (x ⦂ OPEN undefined T) (P x) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Identity_ElementsI T D P ›
  unfolding Action_Tag_def Identity_ElementsI_def OPEN_def
  by blast

private lemma φTA_1R_rule:
  ‹ (⋀x. Ant ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟹ Identity_ElementE (x ⦂ MAKE undefined T) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Identity_ElementsE T D›
  unfolding Action_Tag_def Identity_ElementsE_def MAKE_def
  by blast

private lemma φTA_Ident_I_rule_step:
  ‹ X 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 A
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 A ⟹ Identity_ElementI X Q)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (A ⟶ Q ⟶ P)
⟹ Identity_ElementI X P ›
  unfolding Identity_ElementI_def Premise_def Action_Tag_def Transformation_def Satisfiable_def 𝗋EIF_def
  by (clarsimp, blast)

(* not enabled, DO NOT REMOVE, I am a bit of hesitate
lemma φTA_1I_simp:
  ‹ Identity_ElementsI T D P
⟹ Abstract_Domain T Q
⟹ (⋀x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q x ⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 D' x : D x)
⟹ (⋀x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 P' x : P x)
⟹ Identity_ElementsI T D' P' ›
  unfolding Identity_ElementsI_def Premise_def Simplify_def Abstract_Domain_def Identity_ElementI_def
            Action_Tag_def Transformation_def Satisfiable_def
  by clarsimp blast*)

ML_file ‹library/phi_type_algebra/identity_element.ML›

end


φproperty_deriver Identity_ElementsI 101 for (‹Identity_ElementsI _ _ _›)
  = ‹Phi_Type_Derivers.identity_element_I›

φproperty_deriver Identity_ElementsE 102 for (‹Identity_ElementsE _ _›)
  = ‹Phi_Type_Derivers.identity_element_E›

φproperty_deriver Identity_Element_PropertiesI 103
  = ‹fn (_, pos) => (K (Phi_Type_Derivers.id_ele_properties pos true))›

φproperty_deriver Identity_Element_PropertiesE 103
  = ‹fn (_, pos) =>  (K (Phi_Type_Derivers.id_ele_properties pos false))›

φproperty_deriver Identity_Element_Properties 104
  requires Identity_Element_PropertiesI and Identity_Element_PropertiesE

φproperty_deriver Identity_Elements 105
  requires Identity_ElementsI and Identity_ElementsE and Identity_Element_Properties


paragraph ‹Guessing Antecedents›


subsection ‹Object Equivalence›

context begin

private lemma Object_Equiv_rule:
  ‹ 𝗋EIF Ant Ant'
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x. eq x x))
⟹ (⋀x y. Ant ⟹ eq x y ⟹ (x ⦂ OPEN undefined T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined T) @tag φTA_subgoal undefined)
              ― ‹Induct over ‹x ⦂ T›. When ‹x› is inductively split, the constraint of ‹eq x y›
                  should also split ‹y›, so that ‹y ⦂ T› can reduce.
                  A deficiency is, when the relation ‹eq› is trivially true such as that when
                   ‹T = List ○›, ›
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Object_Equiv T eq ›
  unfolding Object_Equiv_def Premise_def Action_Tag_def MAKE_def OPEN_def 𝗋EIF_def
  by blast

private lemma φTA_OE_rewr_IH:
  ‹Trueprop (Ant ⟶ (∀y. P y ⟶ (x ⦂ OPEN undefined T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f y ⦂ MAKE undefined U)) @tag φTA_subgoal undefined)
≡ (⋀y. Ant ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P y ⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f y ⦂ φTA_IND_TARGET U @tag φTA_ToA_elim)›
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def OPEN_def MAKE_def
            φTA_IND_TARGET_def
  by (rule; blast)


private lemma φTA_OE_rewr_pre:
  ‹ (⋀y. Ant ⟹ P y ⟹ C y @tag 𝒜)
 ≡ Trueprop (Ant ⟶ (∀y. P y ⟶ C y) @tag 𝒜) ›
  unfolding Action_Tag_def atomize_imp atomize_all
  by (rule; blast)

private lemma φTA_OE_rewr_CL:
  ‹ Trueprop (Ant ⟶ (∀y. C y ⟶ X y) @tag 𝒜)
 ≡ (⋀y. Ant ⟹ C y ⟹ X y) ›
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def OPEN_def MAKE_def
  by (rule; blast)

lemma ex_pure_imp:
  ‹ (∃x. P x ⟹ PROP Q) ≡ (⋀x. P x ⟹ PROP Q) ›
proof
  fix x
  assume A: ‹∃x. P x ⟹ PROP Q›
     and B: ‹P x›
  from B have ‹∃x. P x› by blast
  from A[OF this] show ‹PROP Q› .
next
  assume A: ‹⋀x. P x ⟹ PROP Q›
     and B: ‹∃x. P x›
  from B have ‹P (@x. P x)› by (simp add: someI_ex) 
  from A[OF this] show ‹PROP Q› .
qed



private lemma φTA_OE_rewr:
  ‹Trueprop (∀y. P y ⟶ Q y) ≡ (⋀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P y ⟹ Q y)›
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def
  by (rule; blast)

private lemma φTA_OE_rewr':
  ‹Trueprop (∀y. P y ⟶ Q y) ≡ (⋀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P y ⟹ Q y)›
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def
  by (rule; blast)

private lemma φTA_OE_simp:
  ‹ Object_Equiv T eq
⟹ Abstract_Domain T D
⟹ (⋀x y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 D x ⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 eq' x y : eq x y)
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ((∀x. eq x x) ⟶ (∀x. eq' x x))
⟹ Object_Equiv T eq' ›
  unfolding Object_Equiv_def Transformation_def Simplify_def Premise_def
            Abstract_Domain_def Action_Tag_def Satisfiable_def 𝗋EIF_def
  by clarsimp blast

ML_file ‹library/phi_type_algebra/object_equiv.ML›

end


φproperty_deriver Object_Equiv 105 for (‹Object_Equiv _ _›)
  = ‹Phi_Type_Derivers.object_equiv›


subsection ‹Functionality›

context begin

private lemma φTA_IsFunc_rule:
  ‹ (⋀x. Ant ⟹
         𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P x ⟹
         Is_Functional (x ⦂ OPEN undefined T) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Functionality T P ›
  unfolding Action_Tag_def Functionality_def Is_Functional_def Premise_def OPEN_def
  by clarsimp

private lemma φTA_IsFunc_cong:
  ‹ P ≡ P'
⟹ Functionality T P ≡ Functionality T P' ›
  by simp

private lemma φTA_IsFunc_rewr_IH:
  ‹ Trueprop (Ant ⟶ C ⟶ Is_Functional (x ⦂ OPEN undefined T) @tag φTA_subgoal A)
 ≡ (Ant ⟹ C ⟹ Is_Functional (x ⦂ T)) ›
  unfolding Action_Tag_def atomize_imp OPEN_def .

ML_file ‹library/phi_type_algebra/is_functional.ML›

end

φproperty_deriver Functionality 100 for (‹Functionality _ _›)
    = ‹ Phi_Type_Derivers.is_functional ›


subsection ‹Carrier Set›

context begin

private lemma φTA_CarS_rule:
  ‹ (⋀x. Ant ⟹
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P x ⟹
          Within_Carrier_Set (x ⦂ OPEN undefined T) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Carrier_Set T P ›
  unfolding Carrier_Set_def Action_Tag_def Premise_def OPEN_def
  by clarsimp

private lemma φTA_CarS_cong:
  ‹ P ≡ P'
⟹ Carrier_Set T P ≡ Carrier_Set T P' ›
  by simp

private lemma φTA_CarS_rewr_IH:
  ‹ Trueprop (Ant ⟶ C ⟶ Within_Carrier_Set (x ⦂ OPEN undefined T) @tag φTA_subgoal A)
 ≡ (Ant ⟹ C ⟹ Within_Carrier_Set (x ⦂ T)) ›
  unfolding Action_Tag_def atomize_imp OPEN_def .

ML_file ‹library/phi_type_algebra/carrier_set.ML›

end

φproperty_deriver Carrier_Set 100 for (‹Carrier_Set _ _›)
    = ‹ Phi_Type_Derivers.carrier_set ›

φproperty_deriver Basic 109
  requires Object_Equiv and Abstract_Domain and Carrier_Set ?


subsection ‹Type Inhabitance›

context begin

private lemma inh_typ_derv_rule:
  ‹ (Ant @tag φTA_ANT ⟹ Inhabited T)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Inhabited T › .

ML_file ‹library/phi_type_algebra/inhabited_type.ML›

end

φproperty_deriver Inhabited 100 for (‹Inhabited _›)
    = ‹ Phi_Type_Derivers.inhabited_type › 



subsection ‹Equivalent Class›

context begin

private lemma φTA_EC_rule:
  ‹ (Ant ⟹ Equiv_Class (λx. x ⦂ OPEN undefined T) r @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Equiv_Class T r ›
  unfolding Action_Tag_def OPEN_def φType_def .

ML_file ‹library/phi_type_algebra/equiv_class.ML›

end

φproperty_deriver Equiv_Class 100 for (‹Equiv_Class _ _›)
    = ‹ Phi_Type_Derivers.equiv_class › 


subsection ‹Transformation Functor›

context begin

private lemma φTA_TF_rule:
  ‹(⋀g x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x) ⟹
              Ant ⟹
              (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D x ⟹ a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b @tag to U) ⟹ ― ‹split D›
              (x ⦂ OPEN undefined (F1 T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined (F2 U) 𝗌𝗎𝖻𝗃 y. mapper g x y) @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T ⇒ U)))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Transformation_Functor F1 F2 T U D R mapper›
  unfolding Transformation_Functor_def Action_Tag_def Ball_def Premise_def
            OPEN_def MAKE_def
  by simp

private lemma φTA_TF_deriver_cong:
  ‹ D ≡ D'
⟹ (⋀x. ∃a. a ∈ D' x ⟹ R x ≡ R' x)
⟹ (⋀g x y. Satisfiable (x ⦂ F1 T) ⟹ Satisfiable (y ⦂ F2 U) ⟹ m g x y ≡ m' g x y)
⟹ Transformation_Functor F1 F2 T U D R m ≡ Transformation_Functor F1 F2 T U D' R' m' ›
  unfolding Transformation_Functor_def atomize_eq Transformation_def Satisfiable_def
  by clarsimp blast

(*
lemma φTA_TF_rewr_IH:
  ‹Trueprop (Ant ⟶ (∀x. P x ⟶ A2 x) ⟶ C @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T ⇒ U)))
≡ (Ant ⟹ (⋀x. P x ⟹ A2 x @tag to U) ⟹ C @tag to U)›
  unfolding Action_Tag_def atomize_imp atomize_all .
*)

private lemma φTA_TF_rewr_C:
  ‹Trueprop (Ant ⟶ (∀x. P x ⟶ A2 x) ⟶ C @tag φTA_subgoal 𝒜)
≡ (Ant ⟹ (⋀x. P x ⟹ A2 x) ⟹ C @tag 𝒜)›
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_TF_rewr_pre:
  ‹(Ant ⟹ (⋀x. P x ⟹ A2 x) ⟹ C @tag 𝒜)
 ≡ Trueprop (Ant ⟶ (∀x. P x ⟶ A2 x) ⟶ C @tag 𝒜)›
  unfolding Action_Tag_def atomize_imp atomize_all .

paragraph ‹Bi-Functor›

private lemma φTA_biTF_rule:
  ‹(⋀g1 g2 x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. a ∈ D1 x ∧ g1 a b ⟶ b ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x) ⟹
              Ant ⟹
              (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D1 x ⟹ a ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag to U1) ⟹ ― ‹split D›
              (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D2 x ⟹ a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag to U2) ⟹ ― ‹split D›
              (x ⦂ OPEN undefined (F1 T1 T2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined (F2 U1 U2) 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y)
              @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T1 ⇒ U1 𝗈𝗋𝖾𝗅𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T2 ⇒ U2)))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper›
  unfolding Transformation_BiFunctor_def Action_Tag_def Ball_def Premise_def
            OPEN_def MAKE_def
  by simp

private lemma φTA_biTF_rewr_C:
  ‹Trueprop (Ant ⟶ (∀x. P1 x ⟶ A1 x) ⟶ (∀x. P2 x ⟶ A2 x) ⟶ C @tag φTA_subgoal 𝒜)
≡ (Ant ⟹ (⋀x. P1 x ⟹ A1 x) ⟹ (⋀x. P2 x ⟹ A2 x) ⟹ C @tag 𝒜)›
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_biTF_rewr_pre:
  ‹(Ant ⟹ (⋀x. P1 x ⟹ A1 x) ⟹ (⋀x. P2 x ⟹ A2 x) ⟹ C @tag 𝒜)
 ≡ Trueprop (Ant ⟶ (∀x. P1 x ⟶ A1 x) ⟶ (∀x. P2 x ⟶ A2 x) ⟶ C @tag 𝒜)›
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_biTF_deriver_cong:
  ‹ D1 ≡ D'1
⟹ D2 ≡ D'2
⟹ (⋀x. ∃a. a ∈ D'1 x ⟹ R1 x ≡ R'1 x)
⟹ (⋀x. ∃a. a ∈ D'2 x ⟹ R2 x ≡ R'2 x)
⟹ (⋀g1 g2 x y. Satisfiable (x ⦂ F1 T1 T2) ⟹ Satisfiable (y ⦂ F2 U1 U2) ⟹ m g1 g2 x y ≡ m' g1 g2 x y)
⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 m
 ≡ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D'1 D'2 R'1 R'2 m' ›
  unfolding Transformation_BiFunctor_def atomize_eq Transformation_def Satisfiable_def
  by clarsimp (smt (verit, ccfv_threshold))

paragraph ‹Parameterization›

private lemma φTA_TFΛ_rule:
  ‹ (⋀g x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀p a b. a ∈ D p x ∧ g p a b ⟶ b ∈ R p x) ⟹
              Ant ⟹
              (⋀p a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D p x ⟹ a ⦂ T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to (U p)) ⟹ ― ‹split D›
              (x ⦂ MAKE undefined (F1 T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ OPEN undefined (F2 U) 𝗌𝗎𝖻𝗃 y. mapper g x y) @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T ⇒ U)))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Transformation_FunctorΛ F1 F2 T U D R mapper ›
  unfolding Transformation_FunctorΛ_def Action_Tag_def Ball_def Premise_def
            OPEN_def MAKE_def
  by clarsimp

private lemma φTA_TFΛ_deriver_cong:
  ‹ D ≡ D'
⟹ (⋀p x. ∃a. a ∈ D' p x ⟹ R p x ≡ R' p x)
⟹ (⋀g x y. Satisfiable (x ⦂ F1 T) ⟹ Satisfiable (y ⦂ F2 U) ⟹ m g x y ≡ m' g x y)
⟹ Transformation_FunctorΛ F1 F2 T U D R m ≡ Transformation_FunctorΛ F1 F2 T U D' R' m' ›
  unfolding Transformation_FunctorΛ_def atomize_eq Transformation_def Satisfiable_def
  by clarsimp blast

private lemma φTA_TFΛ_rewr_C:
  ‹Trueprop (Ant ⟶ (∀p x. P p x ⟶ A2 p x) ⟶ C @tag φTA_subgoal 𝒜)
≡ (Ant ⟹ (⋀p x. P p x ⟹ A2 p x) ⟹ C @tag 𝒜)›
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_TFΛ_rewr_pre:
  ‹(Ant ⟹ (⋀p x. P p x ⟹ A2 p x) ⟹ C @tag 𝒜)
 ≡ Trueprop (Ant ⟶ (∀p x. P p x ⟶ A2 p x) ⟶ C @tag 𝒜)›
  unfolding Action_Tag_def atomize_imp atomize_all .


subsection ‹Functional Transformation Functor›

paragraph ‹Functor›

private lemma φTA_FTF_rule:
  ‹ 𝗋EIF Ant Ant'
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Transformation_Functor F1 F2 T U D R mapper)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Object_Equiv (F2 U) eq)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀f P x y. mapper (λa b. b = f a ∧ P a) x y ⟶ eq y (fm f P x) ∧ pm f P x))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Functional_Transformation_Functor F1 F2 T U D R pm fm›
  unfolding Premise_def fun_eq_iff Action_Tag_def 𝗋EIF_def
  using infer_FTF_from_FT
  by blast

private lemma φTA_FTF_deriver_cong:
  ‹ D ≡ D'
⟹ (⋀x. ∃a. a ∈ D' x ⟹ R x ≡ R' x)
⟹ (⋀f P x. Satisfiable (x ⦂ F1 T) ⟹ fm f P x ≡ fm' f P x)
⟹ (⋀f P x. Satisfiable (x ⦂ F1 T) ⟹ Satisfiable (fm' f P x ⦂ F2 U) ⟹ pm f P x ≡ pm' f P x)
⟹ Functional_Transformation_Functor F1 F2 T U D R pm fm ≡
    Functional_Transformation_Functor F1 F2 T U D' R' pm' fm' ›
  unfolding Functional_Transformation_Functor_def atomize_eq Transformation_def Satisfiable_def
  by (clarsimp, smt (verit, best))

paragraph ‹Bi-Functor›

private lemma φTA_biFTF_rule:
  ‹ 𝗋EIF Ant Ant'
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Object_Equiv (F2 U1 U2) eq)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀f1 f2 P1 P2 x y. mapper (λa b. b = f1 a ∧ P1 a) (λa b. b = f2 a ∧ P2 a) x y
                                  ⟶ eq y (fm f1 f2 P1 P2 x) ∧ pm f1 f2 P1 P2 x))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Functional_Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 pm fm›
  unfolding Premise_def fun_eq_iff Action_Tag_def 𝗋EIF_def
  using infer_biFTF_from_biFT
  by blast

private lemma φTA_biFTF_deriver_cong:
  ‹ D1 ≡ D'1
⟹ D2 ≡ D'2
⟹ (⋀x. ∃a. a ∈ D'1 x ⟹ R1 x ≡ R'1 x)
⟹ (⋀x. ∃a. a ∈ D'2 x ⟹ R2 x ≡ R'2 x)
⟹ (⋀f1 f2 P1 P2 x. Satisfiable (x ⦂ F1 T1 T2) ⟹ fm f1 f2 P1 P2 x ≡ fm' f1 f2 P1 P2 x)
⟹ (⋀f1 f2 P1 P2 x. Satisfiable (x ⦂ F1 T1 T2) ⟹ Satisfiable (fm' f1 f2 P1 P2 x ⦂ F2 U1 U2) ⟹ pm f1 f2 P1 P2 x ≡ pm' f1 f2 P1 P2 x)
⟹ Functional_Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 pm fm ≡
    Functional_Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D'1 D'2 R'1 R'2 pm' fm' ›
  unfolding Functional_Transformation_BiFunctor_def atomize_eq Transformation_def Satisfiable_def
  by (clarsimp, smt (verit, best))

paragraph ‹Parameterization›

private lemma φTA_FTFΛ_rule:
  ‹ 𝗋EIF Ant Ant'
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Transformation_FunctorΛ F1 F2 T U D R mapper)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Abstract_Domain (F1 T) PT)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Abstract_Domain (F2 U) PU)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ Object_Equiv (F2 U) eq)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant' ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀f P x y. PT x ∧ PU y ∧ mapper (λp a b. b = f p a ∧ P p a) x y ⟶ eq y (fm f P x) ∧ pm f P x))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Functional_Transformation_FunctorΛ F1 F2 T U D R pm fm ›
  unfolding Premise_def Action_Tag_def 𝗋EIF_def
  using infer_FTFΛ_from_FTΛ by blast

private lemma φTA_FTFΛ_deriver_cong:
  ‹ D ≡ D'
⟹ (⋀p x. ∃a. a ∈ D' p x ⟹ R p x ≡ R' p x)
⟹ (⋀f P x. Satisfiable (x ⦂ F1 T) ⟹ fm f P x ≡ fm' f P x)
⟹ (⋀f P x. Satisfiable (x ⦂ F1 T) ⟹ Satisfiable (fm' f P x ⦂ F2 U) ⟹ pm f P x ≡ pm' f P x)
⟹ Functional_Transformation_FunctorΛ F1 F2 T U D R pm fm ≡
    Functional_Transformation_FunctorΛ F1 F2 T U D' R' pm' fm' ›
  unfolding Functional_Transformation_FunctorΛ_def atomize_eq Transformation_def Satisfiable_def
  by (clarsimp, smt (verit, del_insts))


ML_file ‹library/phi_type_algebra/transformation_functor.ML›

end

φproperty_deriver Transformation_Functor 110
    for ( ‹Transformation_Functor _ _ _ _ _ _ _›
        | ‹Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _›
        | ‹Transformation_FunctorΛ _ _ _ _ _ _ _›)
  = ‹ Phi_Type_Derivers.transformation_functor ›

φproperty_deriver Functional_Transformation_Functor 111
  for ( ‹Functional_Transformation_Functor _ _ _ _ _ _ _ _›
      | ‹Functional_Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _ _›
      | ‹Functional_Transformation_FunctorΛ _ _ _ _ _ _ _ _›)
  requires Transformation_Functor
    = ‹Phi_Type_Derivers.functional_transformation_functor›


subsection ‹Separation Homo›

text ‹Note, as an instance of Commutativity of Type Operators, the names of ‹introduction rule›
  and ‹elimination rule› are just reversed. It is intentional, because I really think those names
  are more natural and we don't really have to force the consistency of the names between the two levels.›

context begin

paragraph ‹Normal›

private lemma φTA_SHI_rule:
  ‹ (⋀z. Ant ⟹
            (∀x y. (x,y) ∈ D ∧ w(x,y) = z
                ⟶ ((x ⦂ OPEN undefined (Fa T)) * (y ⦂ OPEN undefined (Fb U))
                    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ MAKE undefined (Fc (T ∗ U)))) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Separation_HomoI Fa Fb Fc T U D w ›
  unfolding Separation_HomoI_def φProd_expn' Action_Tag_def MAKE_def OPEN_def
  by simp

private lemma φTA_SHE_rule:
  ‹ (⋀z. Ant ⟹ 
        (z ∈ D ⟶
          (z ⦂ OPEN undefined (Fc (T ∗𝒜 U))
           𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz z ⦂ NO_SIMP φProd (MAKE undefined (Ft T)) (MAKE undefined (Fu U)))
        ) @tag φTA_subgoal 𝒜simp)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Separation_HomoE Ft Fu Fc T U D uz ›
  unfolding Separation_HomoE_def φProd_expn' Action_Tag_def Bubbling_def MAKE_def OPEN_def NO_SIMP_def
  by simp

private lemma φTA_SHI_rewr_IH:
  ‹Trueprop (Ant ⟶ (∀x y. P x y ⟶ ((x ⦂ OPEN undefined Ta) * (y ⦂ OPEN undefined Tb)
                                      𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ MAKE undefined Tc)) @tag φTA_subgoal undefined)
≡ (⋀x y. Ant @tag φTA_ANT ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P x y ⟹ ((x ⦂ Ta) * (y ⦂ Tb) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Tc) @tag φTA_ToA_elim)›
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def OPEN_def MAKE_def
  by (rule; blast)

text ‹This conditioned template is necessary because, see,
  prop‹(∀x y. (x,y) ∈ D ∧ w(x,y) = z ⟶ ((y ⦂ Fb U) * (x ⦂ Fa T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Fc (T ∗ U)))›
  term‹z› does not determine ‹x› and ‹y› during the reasoning phase and until the phase of proof obligation solving.
  When there are multiple choices of such induction hypotheses, for sure, we can attempt every choice
  exhaustively, but it multiplies the search branches and can harm the performance dramatically.

  Update: perhaps, the conditioned template is not that necessary, because it doesn't really matter
  when ‹x,y› are undetermined, as they are still constrained by conditions given to proof obligations.
  The form of abstract objects should never matter. All syntactic information guiding the reasoning
  should only be given from φ-type, while the syntax of abstract objects shouldn't bear any convention
  nor expectation.

  BTW, I think we have no way to circumvent the reasoning branches even enormous, because there is a
  fallback always varifies the abstract object in the target to a schematic variable.
›

private lemma φTA_SHE_rewr_IH:
  ‹Trueprop (Ant ⟶ CC ⟶ (z ⦂ OPEN undefined T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz ⦂ MAKE undefined U1 ∗ MAKE undefined U2)
            @tag φTA_subgoal A)
≡ (Ant @tag φTA_ANT ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 CC ⟹ z ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z' ⦂ U1 ∗ U2 𝗌𝗎𝖻𝗃 z'. z' = uz @tag A)›
  unfolding Action_Tag_def atomize_imp atomize_all OPEN_def MAKE_def Premise_def
  by simp

private lemma φTA_SHI_DV_cong:
  ‹ D ≡ D'
⟹ z ≡ z'
⟹ Separation_HomoI Ft Fu Fc T U D z ≡ Separation_HomoI Ft Fu Fc T U D' z' ›
  by simp

private lemma φTA_SHE_DV_cong:
  ‹ u ≡ u'
⟹ Separation_HomoE Ft Fu Fc T U D u ≡ Separation_HomoE Ft Fu Fc T U D u' ›
  by simp

paragraph ‹With Parameterization›

private lemma φTA_SHΛI_rule:
  ‹ (⋀z. Ant ⟹
            (∀x y. (x,y) ∈ D ∧ w(x,y) = z
                ⟶ ((x ⦂ OPEN undefined (Fa T)) * (y ⦂ OPEN undefined (Fb U))
                    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ MAKE undefined (Fc (λp. T p ∗ U p))))
            @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Separation_HomoΛI Fa Fb Fc T U D w ›
  unfolding Separation_HomoΛI_def φProd_expn' Action_Tag_def MAKE_def OPEN_def
  by simp

private lemma φTA_SHΛE_rule:
  ‹ (⋀z. Ant ⟹ 
        (z ∈ D ⟶
            (z ⦂ OPEN undefined (Fc (λp. T p ∗𝒜 U p))
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz z ⦂ NO_SIMP φProd (MAKE undefined (Ft T)) (MAKE undefined (Fu U))))
          @tag φTA_subgoal 𝒜simp)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Separation_HomoΛE Ft Fu Fc T U D uz ›
  unfolding Separation_HomoΛE_def φProd_expn' Action_Tag_def Bubbling_def
            MAKE_def OPEN_def NO_SIMP_def
  by simp

private lemma φTA_SHΛI_DV_cong:
  ‹ D ≡ D'
⟹ z ≡ z'
⟹ Separation_HomoΛI Ft Fu Fc T U D z ≡ Separation_HomoΛI Ft Fu Fc T U D' z' ›
  by simp

private lemma φTA_SHΛE_DV_cong:
  ‹ u ≡ u'
⟹ Separation_HomoΛE Ft Fu Fc T U D u ≡ Separation_HomoΛE Ft Fu Fc T U D u' ›
  by simp

private lemma φTA_SHE_rewr_pre:
  ‹ (Ant ⟹ CC ⟶(X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ NO_SIMP φProd T U) @tag 𝒜)
≡ Trueprop (Ant ⟶ CC ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ T ∗ U) @tag 𝒜) ›
  unfolding atomize_imp Action_Tag_def NO_SIMP_def .


ML_file ‹library/phi_type_algebra/separation_homo.ML›

end

(*
hide_fact φTA_SHI_rule φTA_SHE_rule φTA_SHI_rewr_IH φTA_SHI_rewr_C
          φTA_SHE_rewr_IH φTA_SHE_rewr_C*)

φproperty_deriver Separation_HomoI 120
  for (‹Separation_HomoI _ _ _ _ _ _ _› | ‹Separation_HomoΛI _ _ _ _ _ _ _›)
    = ‹ Phi_Type_Derivers.separation_homo_I ›

φproperty_deriver Separation_HomoE 121
  for (‹Separation_HomoE _ _ _ _ _ _ _› | ‹Separation_HomoΛE _ _ _ _ _ _ _›)
    = ‹ Phi_Type_Derivers.separation_homo_E ›

φproperty_deriver Separation_Homo 122 requires Separation_HomoI and Separation_HomoE

φproperty_deriver Sep_Functor 130 
  requires Separation_Homo
       and Functional_Transformation_Functor
       and Basic
  ― ‹A separation functor is defined as a transformation functor which is also extendedly commutative
     with separation operator ‹∗›. The extended commutativity means existing a pair of function ‹z,u› with
     ‹x ⦂ F(T) ∗ F(U) ⟶ z x ⦂ F(T ∗ U)› and ‹y ⦂ F(T ∗ U) ⟶ u y ⦂ F(T) ∗ F(U)› for any ‹x,y›, and it degenerates
     to the usual commutativity when ‹z, u = λx. x›.›

φproperty_deriver Sep_Functor_1 131
  requires Sep_Functor
       and Identity_Elements
       and Identity_Element_Properties


subsection ‹Congruence in Function Definition›

(*TODO: re-implement by template*)

lemma function_congruence_template:
  ‹ (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y ∧ (∀a ∈ D x. T a = U a) ∧ eqs ⟹ Transformation_Functor F F' T U D R M)
⟹ (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y ∧ (∀a ∈ D x. T a = U a) ∧ eqs ⟹ Transformation_Functor F' F U T D' R' M')
⟹ (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y ∧ (∀a ∈ D x. T a = U a) ∧ eqs ⟹ Object_Equiv (F' U) eq')
⟹ (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y ∧ (∀a ∈ D x. T a = U a) ∧ eqs ⟹ Object_Equiv (F T) eq)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (x = y ∧ eqs ⟶
              D x ⊆ R x ∧ (∀x y. M (=) x y ⟶ eq' y x) ∧ (∀x. D x = D' x) ∧
              D' y ⊆ R' y ∧ (∀x y. M' (=) y x ⟶ eq x y))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ eqs
⟹ x = y
⟹ (⋀a. a ∈ D y ⟹ T a = U a)
⟹ F T x = F' U y ›
  unfolding fun_eq_iff[symmetric, where f=D]
  unfolding Transformation_Functor_def Premise_def Transformation_def φType_def BI_eq_iff
            subset_iff meta_Ball_def Ball_def Object_Equiv_def
  apply clarify
  subgoal premises prems for u
    by (insert prems(1)[THEN spec[where x=y], THEN spec[where x=‹(=)›]]
               prems(2)[THEN spec[where x=y], THEN spec[where x=‹(=)›]]
               prems(3-);
        clarsimp; rule; meson) .

(* (*This package is still necessary but I have no good idea to realize it now.
     Maybe I think there should be an ad-hoc deriver maybe?
     The thing is the conditions of the congruence rule cannot be robustly inferred.*)
ML_file ‹library/phi_type_algebra/function_congruence.ML›
*)

subsection ‹Configuration for guessing default Semimodule properties›

definition Guess_Scalar_Zero :: ‹ 's itself ⇒ 'c::one itself ⇒ 'a itself
                              ⇒ ('s ⇒ ('c,'a) φ)
                              ⇒ ('s ⇒ ('c,'a) φ)
                              ⇒ 's
                              ⇒ bool ⇒ bool
                              ⇒ bool ›
  where ‹Guess_Scalar_Zero _ _ _ F unfolded_F zero ants conds ≡ True›

definition Guess_Scalar_OneI :: ‹ 's itself ⇒ 'cT itself ⇒ 'c itself ⇒ 'aT itself ⇒'a itself
                              ⇒ ('s ⇒ ('c,'a) φ)
                              ⇒ ('s ⇒ ('c,'a) φ)
                              ⇒ ('cT,'aT) φ
                              ⇒ ('c,'a1) φ
                              ⇒ 's ⇒ ('a1 ⇒ bool) ⇒ ('a1 ⇒ 'a) ⇒ ('a1 ⇒ bool)
                              ⇒ bool ⇒ bool
                              ⇒ bool ›
  where ‹Guess_Scalar_OneI _ _ _ _ _ F unfolded_F T T1 one Dx f P ants conds ≡ True›

definition Guess_Scalar_OneE :: ‹ 's itself ⇒ 'cT itself ⇒ 'c itself ⇒ 'aT itself => 'a itself
                              ⇒ ('s ⇒ ('c,'a) φ)
                              ⇒ ('s ⇒ ('c,'a) φ)
                              ⇒ ('cT,'aT) φ
                              ⇒ ('c,'a1) φ
                              ⇒ 's ⇒ ('a ⇒ bool) ⇒ ('a ⇒ 'a1) ⇒ ('a ⇒ bool)
                              ⇒ bool ⇒ bool
                              ⇒ bool ›
  where ‹Guess_Scalar_OneE _ _ _ _ _ F unfolded_F T T1 one Dx f P ants conds ≡ True›

definition Guess_Scalar_AssocI :: ‹ 'sc itself ⇒ 'c itself ⇒ 'cst itself ⇒ 'a itself ⇒ 'ast itself
                                 ⇒ ('ss ⇒ ('ct,'at) φ ⇒ ('cst,'as_t) φ)
                                 ⇒ ('st ⇒ ('c,'a) φ ⇒ ('ct,'at) φ)
                                 ⇒ ('sc ⇒ ('c,'a) φ ⇒ ('cst,'ast) φ)
                                 ⇒ ('sc ⇒ ('c,'a) φ ⇒ ('cst,'ast) φ)
                                 ⇒ ('c,'a) φ
                                 ⇒ ('ss ⇒ bool)
                                 ⇒ ('st ⇒ bool)
                                 ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ bool)
                                 ⇒ ('ss ⇒ 'st ⇒ 'sc)
                                 ⇒ ('ss ⇒ 'st ⇒ 'as_t ⇒ 'ast)
                                 ⇒ bool ⇒ bool
                                 ⇒ bool›
  where ‹Guess_Scalar_AssocI _ _ _ _ _ Fs Ft Fc unfolded_Fc T Ds Dt Dx smul f ants conds ≡ True›

definition Guess_Scalar_AssocE :: ‹ 'sc itself ⇒ 'c itself ⇒ 'cst itself ⇒ 'a itself ⇒ 'ast itself
                                 ⇒ ('ss ⇒ ('ct,'at) φ ⇒ ('cst,'as_t) φ)
                                 ⇒ ('st ⇒ ('c,'a) φ ⇒ ('ct,'at) φ)
                                 ⇒ ('sc ⇒ ('c,'a) φ ⇒ ('cst,'ast) φ)
                                 ⇒ ('sc ⇒ ('c,'a) φ ⇒ ('cst,'ast) φ)
                                 ⇒ ('c,'a) φ
                                 ⇒ ('ss ⇒ bool)
                                 ⇒ ('st ⇒ bool)
                                 ⇒ ('ss ⇒ 'st ⇒ 'ast ⇒ bool)
                                 ⇒ ('ss ⇒ 'st ⇒ 'sc)
                                 ⇒ ('ss ⇒ 'st ⇒ 'ast ⇒ 'as_t)
                                 ⇒ bool ⇒ bool
                                 ⇒ bool›
  where ‹Guess_Scalar_AssocE _ _ _ _ _ Fs Ft Fc unfolded_Fc T Ds Dt Dx smul f ants conds ≡ True›


definition Guess_Zip_of_Semimodule :: ‹'s itself ⇒ ('c::sep_magma) itself ⇒ 'a itself
                                      ⇒ ('s ⇒ ('c,'a) φ)
                                      ⇒ ('s ⇒ ('c,'a) φ)
                                      ⇒ ('s ⇒ bool)
                                      ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ bool)
                                      ⇒ ('s ⇒ 's ⇒ 'a × 'a ⇒ 'a)
                                      ⇒ bool ⇒ bool
                                      ⇒ bool›
  where ‹Guess_Zip_of_Semimodule type_scalar type_concrete type_abstract
                                 F unfolded_F_def
                                 domain_of_scalar domain_of_abstract zip_opr
                                 antecedents conditions_of_antecedents
       ≡ True›

definition Guess_Unzip_of_Semimodule :: ‹'s itself ⇒ 'c itself ⇒ 'a itself
                                      ⇒ ('s ⇒ ('c,'a) φ)
                                      ⇒ ('s ⇒ ('c,'a) φ)
                                      ⇒ ('s ⇒ bool)
                                      ⇒ ('s ⇒ 's ⇒ 'a ⇒ bool) 
                                      ⇒ ('s ⇒ 's ⇒ 'a ⇒ 'a × 'a)
                                      ⇒ bool ⇒ bool
                                      ⇒ bool›
  where ‹Guess_Unzip_of_Semimodule type_scalar type_concrete type_abstract
                                   F unfolded_typ_def
                                   domain_of_scalar domain_of_abstract unzip_opr
                                   antecedents conditions_of_antecedents
       ≡ True›

declare [[ φreason_default_pattern
      (*‹Guess_Scalar_OneI ?S ?C ?AT ?A _ ?def ?T _ _ _› ⇒
      ‹Guess_Scalar_OneI ?S ?C ?AT ?A _ ?def ?T _ _ _›   (100)
  and*)
      ‹Guess_Scalar_Zero ?S ?C ?A _ ?def _ _ _› ⇒
      ‹Guess_Scalar_Zero ?S ?C ?A _ ?def _ _ _›   (100)
  and ‹Guess_Scalar_OneI ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _› ⇒
      ‹Guess_Scalar_OneI ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _›   (100)
  and ‹Guess_Scalar_OneE ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _› ⇒
      ‹Guess_Scalar_OneE ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _›   (100)
  and ‹Guess_Zip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _› ⇒
      ‹Guess_Zip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _›   (100)
  and ‹Guess_Unzip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _› ⇒
      ‹Guess_Unzip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _›   (100)
  and ‹Guess_Scalar_AssocI ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _› ⇒
      ‹Guess_Scalar_AssocI ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _›   (100)
  and ‹Guess_Scalar_AssocE ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _› ⇒
      ‹Guess_Scalar_AssocE ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _›   (100)
]]

text ‹Guessing the zip operation of a semimodule is far beyond what can be inferred from BNF,
      partially because a semimodule is over two algebraic sorts (i.e., two logical types).
      Due to this, the guessing of the abstract operators of semimodules more relies on pre-registered
      records over the logical types.›

paragraph ‹Initialization›

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x ⦂ F s) )
⟹ Guess_Scalar_Zero TS TC TA F var_unfolded_F z ants conds
⟹ Guess_Scalar_Zero TS TC TA F var_unfolded_F z ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x ⦂ F s) )
⟹ Guess_Scalar_OneI TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds
⟹ Guess_Scalar_OneI TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x ⦂ F s) )
⟹ Guess_Scalar_OneE TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds
⟹ Guess_Scalar_OneE TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_Fc s T x) : (x ⦂ Fc s T) )
⟹ Guess_Scalar_AssocI TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds
⟹ Guess_Scalar_AssocI TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_Fc s T x) : (x ⦂ Fc s T) )
⟹ Guess_Scalar_AssocE TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds
⟹ Guess_Scalar_AssocE TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x ⦂ F s) )
⟹ Guess_Zip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds
⟹ Guess_Zip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ (⋀s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x ⦂ F s) )
⟹ Guess_Unzip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds
⟹ Guess_Unzip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds› .


paragraph ‹Guess_Scalar_Zero›

lemma [φreason %φTA_guesser_fallback]:
  ‹Guess_Scalar_Zero TYPE('s::zero) TYPE('c::one) TYPE('a)
                     F unfolded_F 0 True True ›
  unfolding Guess_Scalar_Zero_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_Zero TYPE('s len_intvl) TYPE('c::one) TYPE('a list)
                     F unfolded_F ⟦x:0⦆ True True›
  unfolding Guess_Scalar_Zero_def ..

paragraph ‹Guess_Scalar_One›

(* lemma [φreason %φTA_guesser_fallback]:
  ‹Guess_Scalar_OneI TYPE('s::one) TYPE('c) TYPE('a) TYPE('a)
                     F whateverT 1 (λ_. True) (λx. x)›
  unfolding Guess_Scalar_OneI_def .. *)

lemma [φreason %φTA_guesser_fallback]:
  ‹Guess_Scalar_OneI TYPE('s::one) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                     F whatever T T 1 (λ_. True) (λx. x) (λ_. True) True True›
  unfolding Guess_Scalar_OneI_def ..

lemma [φreason %φTA_guesser_fallback]:
  ‹Guess_Scalar_OneE TYPE('s::one) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                     F whatever T T 1 (λ_. True) (λx. x) (λ_. True) True True›
  unfolding Guess_Scalar_OneE_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_OneI TYPE('s len_intvl) TYPE('c) TYPE('c) TYPE('a) TYPE('a list)
                     F whatever T T ⟦x:1⦆ (λ_. True) (λx. [x]) (λ_. True) True True›
  unfolding Guess_Scalar_OneI_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_OneE TYPE('s len_intvl) TYPE('c) TYPE('c) TYPE('a) TYPE('a list)
                     F whatever T T ⟦x:1⦆ (λl. length l = 1) hd (λ_. True) True True›
  unfolding Guess_Scalar_OneE_def ..

(* lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_OneI TYPE('i set) TYPE('c::sep_algebra) TYPE('a) TYPE('i ⇒ 'a)
                     F (λs T x. ✱ (A s T x) s) T {any} (λ_. True) (λx _. x) ›
  unfolding Guess_Scalar_OneI_def .. *)

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_OneI TYPE('i set) TYPE('c) TYPE('c::sep_algebra) TYPE('a) TYPE('i ⇒ 'a)
                     F (λs x. ✱ (A s x) s) T T {i} (λ_. True) (λx _. x) (λ_. True) True True›
  unfolding Guess_Scalar_OneI_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_OneE TYPE('i set) TYPE('c) TYPE('c::sep_algebra) TYPE('a) TYPE('i ⇒ 'a)
                     F (λs x. ✱ (A s x) s) T T {i} (λ_. True) (λf. f i) (λ_. True) True True›
  unfolding Guess_Scalar_OneE_def ..


paragraph ‹Guess_Scalar_Assoc›

lemma [φreason %φTA_guesser_default[bottom]]:
  ‹Guess_Scalar_AssocI TYPE('s::times) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T (λ_. True) (λ_. True) (λ_ _ _. True) (*) (λ_ _ x. x) True True›
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_AssocI TYPE(rat) TYPE('c::share) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((<) 0) ((<) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True›
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default+1]:
  ‹Guess_Scalar_AssocI TYPE(rat) TYPE('c::share_one) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((≤) 0) ((≤) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True›
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default[bottom]]:
  ‹Guess_Scalar_AssocE TYPE('s::times) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T (λ_. True) (λ_. True) (λ_ _ _. True) (*) (λ_ _ x. x) True True›
  unfolding Guess_Scalar_AssocE_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_AssocE TYPE(rat) TYPE('c::share) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((<) 0) ((<) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True›
  unfolding Guess_Scalar_AssocE_def ..

lemma [φreason %φTA_guesser_default+1]:
  ‹Guess_Scalar_AssocE TYPE(rat) TYPE('c::share_one) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((≤) 0) ((≤) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True›
  unfolding Guess_Scalar_AssocE_def ..

lemma [φreason %φTA_guesser_default for
        ‹Guess_Scalar_AssocI TYPE(_ set) TYPE(_) TYPE(_) TYPE(_) TYPE(_) _ _ _ (λs T x. ✱ (?A s T x) s) _
                            _ _ _ _ _ _ _›]:
  ‹ Type_Variant_of_the_Same_Scalar_Mul Fc Fs
⟹ Type_Variant_of_the_Same_Scalar_Mul Fc Ft
⟹ Guess_Scalar_AssocI TYPE(('i × 'j) set) TYPE('c::sep_algebra) TYPE('c) TYPE('a) TYPE('i × 'j ⇒ 'a)
                      Fs Ft Fc (λs T x. ✱ (A s T x) s) T (λ_. True) (λ_. True) (λ_ _ _. True)
                      (×) (λ_ _. case_prod) True True ›
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default for
        ‹Guess_Scalar_AssocE TYPE(_ set) TYPE(_) TYPE(_) TYPE(_) TYPE(_) _ _ _ (λs T x. ✱ (?A s T x) s) _
                            _ _ _ _ _ _ _›]:
  ‹ Type_Variant_of_the_Same_Scalar_Mul Fc Fs
⟹ Type_Variant_of_the_Same_Scalar_Mul Fc Ft
⟹ Guess_Scalar_AssocE TYPE(('i × 'j) set) TYPE('c::sep_algebra) TYPE('c) TYPE('a) TYPE('i × 'j ⇒ 'a)
                      Fs Ft Fc (λs T x. ✱ (A s T x) s) T finite finite (λ_ _ _. True)
                      (×) (λ_ _. curry) True True ›
  unfolding Guess_Scalar_AssocE_def ..


paragraph ‹Guess_(Un)Zip_of_Semimodule›

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Zip_of_Semimodule TYPE(rat) TYPE('c::sep_magma) TYPE('a)
                           F any
                           (λx. 0 ≤ x) (λ_ _ (x,y). x = y) (λ_ _ (x,y). x)
                           True True ›
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Unzip_of_Semimodule TYPE(rat) TYPE('c::sep_magma) TYPE('a)
                             F any
                             (λx. 0 ≤ x) (λ_ _ x. True) (λ_ _ x. (x,x))
                             True True ›
  unfolding Guess_Unzip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Zip_of_Semimodule TYPE(nat lcro_intvl) TYPE('c::sep_magma) TYPE('a list)
                           F any (λ_. True)
                           (λs t (x,y). LCRO_Interval.width_of s = length x ∧ LCRO_Interval.width_of t = length y)
                           (λ_ _ (x,y). x @ y)
                           True True›
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Unzip_of_Semimodule TYPE(nat lcro_intvl) TYPE('c::sep_magma) TYPE('a list)
                             F any (λ_. True)
                             (λs t x. LCRO_Interval.width_of s + LCRO_Interval.width_of t = length x)
                             (λs t x. (take (LCRO_Interval.width_of s) x, drop (LCRO_Interval.width_of s) x))
                             True True›
  unfolding Guess_Unzip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Zip_of_Semimodule TYPE('s len_intvl) TYPE('c::sep_magma) TYPE('a list)
                           F any (λ_. True)
                           (λs t (x,y). length x = len_intvl.len s ∧ length y = len_intvl.len t)
                           (λ_ _ (x,y). x @ y)
                           True True›
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Unzip_of_Semimodule TYPE('s len_intvl) TYPE('c::sep_magma) TYPE('a list)
                             F any (λ_. True)
                             (λs t x. length x = len_intvl.len s + len_intvl.len t)
                             (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
                             True True›
  unfolding Guess_Unzip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Zip_of_Semimodule TYPE('i set) TYPE('c::sep_algebra) TYPE('i ⇒ 'a)
                           F (λs x. ✱ (A s x) s)
                           (λ_. True) (λ_ _ _. True) (λ_ Dg (f,g). f ⊕f[Dg] g) True True ›
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  ‹Guess_Unzip_of_Semimodule TYPE('i set) TYPE('c::sep_algebra) TYPE('i ⇒ 'a)
                             F (λs x. ✱ (A s x) s)
                             (λ_. True) (λ_ _ _. True) (λ_ _ f. (f,f)) True True ›
  unfolding Guess_Unzip_of_Semimodule_def ..


paragraph ‹ML Library›

ML_file ‹library/phi_type_algebra/guess_semimodule.ML›


subsection ‹Semimodule Scalar Zero›

context begin

private lemma φTA_M0_rule:
  ‹ (⋀x. Ant ⟹ Identity_ElementI (x ⦂ OPEN undefined (F zero)) True
                  @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_Zero F zero ›
  unfolding Module_Zero_def Action_Tag_def Premise_def
            Identity_ElementI_def Identity_ElementE_def OPEN_def
  by (clarsimp simp add: BI_eq_iff Transformation_def; blast)

private lemma φTA_M0c_rule:
  ‹ (⋀x. Ant ⟹ Identity_ElementE (x ⦂ MAKE undefined (F zero))
                  @tag φTA_subgoal undefined)
⟹ Module_Zero F zero
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Closed_Module_Zero F zero ›
  unfolding Module_Zero_def Action_Tag_def Premise_def Identity_ElementI_def Identity_ElementE_def
            Closed_Module_Zero_def MAKE_def
  by (clarsimp simp add: BI_eq_iff Transformation_def; blast)

private lemma φTA_M0_rewr_IH:
  ‹ Trueprop (Ant ⟶ Identity_ElementI (x ⦂ OPEN undefined T) True @tag φTA_subgoal A)
 ≡ (Ant ⟹ Identity_ElementI (x ⦂ T) True ) ›
  unfolding Action_Tag_def atomize_imp OPEN_def .

private lemma φTA_M0c_rewr_IH:
  ‹ Trueprop (Ant ⟶ Identity_ElementE (x ⦂ MAKE undefined T) @tag φTA_subgoal A)
 ≡ (Ant ⟹ Identity_ElementE (x ⦂ T) ) ›
  unfolding Action_Tag_def atomize_imp MAKE_def .

ML_file ‹library/phi_type_algebra/Module_Zero.ML›

end

φproperty_deriver Module_Zero 129 for (‹Module_Zero _ _›)
    = ‹Phi_Type_Derivers.Module_Zero›

φproperty_deriver Closed_Module_Zero 130
  for (‹Closed_Module_Zero _ _›)
  requires Module_Zero
    = ‹Phi_Type_Derivers.closed_Module_Zero›


subsection ‹Semimodule Scalar Identity›

context begin

private lemma φTA_MIE_rule:
  ‹ (⋀x. Ant
      ⟶ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 D x
      ⟶ (x ⦂ F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ T1 𝗐𝗂𝗍𝗁 PE x) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_OneE F T1 one D f PE ›
  unfolding Module_OneE_def Action_Tag_def Premise_def Transformation_def
  by (clarsimp; metis)

private lemma φTA_MII_rule:
  ‹ (⋀x. Ant
      ⟶ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 D x
      ⟶ (x ⦂ T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F one 𝗐𝗂𝗍𝗁 PI x) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_OneI F T1 one D f PI ›
  unfolding Module_OneI_def Action_Tag_def Premise_def Transformation_def
  by (clarsimp; metis)

ML_file ‹library/phi_type_algebra/semimodule_identity.ML›

end

φproperty_deriver Module_OneI 130 for (‹Module_OneI _ _ _ _ _ _›)
    = ‹Phi_Type_Derivers.semimodule_identity_I›

φproperty_deriver Module_OneE 130 for (‹Module_OneE _ _ _ _ _ _›)
    = ‹Phi_Type_Derivers.semimodule_identity_E›

φproperty_deriver Module_One 131
  requires Module_OneI and Module_OneE


subsection ‹Semimodule Scalar Associative›

text ‹φ-type embedding of separation quantifier ‹x ⦂ ✱[i∈I] T› is a recursive example of this.

  The induction of the φ-type should expand the scalar as the scalar usually represents the domain of the φ-type abstraction. 
›

context begin

private lemma φTA_MSI_rule:
  ‹ (⋀t s x r y. Ant
         ⟶ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ Dx s t x ∧ r = smul s t ∧ f s t x = y
         ⟶ (x ⦂ OPEN undefined (Fs s (OPEN undefined (Ft t T)))
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined (Fc r T)) @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_AssocI Fs Ft Fc T Ds Dt Dx smul f ›
  unfolding Module_AssocI_def Action_Tag_def Premise_def MAKE_def OPEN_def
  by clarsimp

private lemma φTA_MSE_rule:
  ‹ (⋀t s r x. Ant
         ⟶ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s ∧ Dt t ∧ r = smul s t ∧ Dx s t x
         ⟶ (x ⦂ OPEN undefined (Fc r T)
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x ⦂ MAKE undefined (Fs s (MAKE undefined (Ft t T))))
         @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_AssocE Fs Ft Fc T Ds Dt Dx smul f ›
  unfolding Module_AssocE_def Action_Tag_def Premise_def MAKE_def OPEN_def
  by clarsimp

private lemma φTA_MSI_rewr_IH:
  ‹ Trueprop (Ant ⟶ C ⟶ (x ⦂ OPEN undefined U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined T 𝗐𝗂𝗍𝗁 P) @tag A)
 ≡ (Ant ⟹ C ⟹ x ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ φTA_IND_TARGET T 𝗐𝗂𝗍𝗁 P) ›
  unfolding Action_Tag_def atomize_imp φTA_IND_TARGET_def OPEN_def MAKE_def .


ML_file ‹library/phi_type_algebra/semimodule_scalar.ML›
                            
end

φproperty_deriver Module_AssocI 130 for (‹Module_AssocI _ _ _ _ _ _ _ _ _›)
    = ‹Phi_Type_Derivers.semimodule_assoc_I›

φproperty_deriver Module_AssocE 130 for (‹Module_AssocE _ _ _ _ _ _ _ _ _›)
    = ‹Phi_Type_Derivers.semimodule_assoc_E›

φproperty_deriver Module_Assoc 131
  requires Module_AssocI and Module_AssocE

φproperty_deriver Semimodule_NonDistr_no0 132
  requires Module_Assoc and Module_One
       and Semimodule_No_SDistr

φproperty_deriver Semimodule_NonDistr 133
  requires Semimodule_NonDistr_no0 and Module_Zero


subsection ‹Semimodule Scalar Distributivity - Zip›

context begin

bundle φTA_MD =
  [[φreason_default_pattern ‹equation21 ?c ?a ?b› ⇒ ‹equation21 _ _ _› (1000)]]

φreasoner_group 𝒜_partial_add_local = (3850, [3850, 3850]) in 𝒜_partial_add__top ‹›

private lemma φTA_MDZ_rule:
  ‹ (⋀s t x r z. Ant
         ⟹ equation31_cond False True unspec s s t r
         ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ Dx s t x ∧ zi s t x = z
         ⟹ (x ⦂ NO_SIMP φProd (OPEN undefined (F s)) (OPEN undefined (F t))
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ MAKE undefined (F r))
         @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_Distr_HomoZ F Ds Dx zi ›
  unfolding Module_Distr_HomoZ_def Action_Tag_def Premise_def Transformation_def
            OPEN_def MAKE_def NO_SIMP_def equation31_cond_def
  by clarsimp

private lemma φTA_MDU_rule:
  ‹ (⋀s t r x. Ant
         ⟹ equation31_cond False True unspec s s t r
         ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ Dx s t x
         ⟹ (x ⦂ OPEN undefined (F r)
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ NO_SIMP φProd (MAKE undefined (F s)) (MAKE undefined (F t)))
        @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 F r ⇒ 𝗌𝗉𝗅𝗂𝗍-𝗌𝖼𝖺𝗅𝖺𝗋 s t)))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Module_Distr_HomoS F Ds Dx uz ›
  unfolding Module_Distr_HomoS_def Action_Tag_def Premise_def Transformation_def
            OPEN_def MAKE_def NO_SIMP_def equation31_cond_def
  by clarsimp

private lemma φTA_MDU_cong:
  ‹ Ds ≡ Ds'
⟹ (⋀t s x. Ds' t ⟹ Ds' s ⟹ s ##+ t ⟹ Dx  s t x ≡ Dx' s t x)
⟹ (⋀t s x. Ds' t ⟹ Ds' s ⟹ s ##+ t ⟹ Dx' s t x ⟹ uz s t x ≡ uz' s t x)
⟹ Module_Distr_HomoS F Ds Dx uz ≡ Module_Distr_HomoS F Ds' Dx' uz' ›
  unfolding Module_Distr_HomoS_def atomize_eq Transformation_def
  by clarsimp metis

private lemma φTA_MDZ_cong:
  ‹ Ds ≡ Ds'
⟹ (⋀t s x. Ds' t ⟹ Ds' s ⟹ s ##+ t ⟹ Dx s t x ≡ Dx' s t x)
⟹ (⋀t s x. Ds' t ⟹ Ds' s ⟹ s ##+ t ⟹ Dx' s t x ⟹ z s t x ≡ z' s t x)
⟹ Module_Distr_HomoZ F Ds Dx z ≡ Module_Distr_HomoZ F Ds' Dx' z' ›
  unfolding Module_Distr_HomoZ_def atomize_eq Transformation_def
  by (auto; metis)

private lemma φTA_MDZ_rewr_IH:
  ‹ Trueprop (Ant ⟶ C2 ⟶ C ⟶ (x ⦂ OPEN undefined U1 ∗ OPEN undefined U2
                             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined T 𝗐𝗂𝗍𝗁 P) @tag A)
 ≡ (Ant @tag φTA_ANT ⟹ C2 ⟹ C ⟹ x ⦂ U1 ∗ U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ φTA_IND_TARGET T 𝗐𝗂𝗍𝗁 P @tag φTA_ToA_elim) ›
  unfolding Action_Tag_def atomize_imp φTA_IND_TARGET_def OPEN_def MAKE_def .

private lemma φTA_MDU_rewr_IH:
  ‹ Trueprop (Ant ⟶ C2 ⟶ C ⟶ (x ⦂ OPEN undefined T
                             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined U1 ∗ MAKE undefined U2 𝗐𝗂𝗍𝗁 P) @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 AA ⇒ A)))
 ≡ (Ant @tag φTA_ANT ⟹ C2 ⟹ C ⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U1 ∗ U2 𝗐𝗂𝗍𝗁 P @tag (to A)) ›
  unfolding Action_Tag_def atomize_imp φTA_IND_TARGET_def OPEN_def MAKE_def .

private lemma φTA_MDZ_rewr_pre:
  ‹ (Ant ⟹ C2 ⟹ C ⟹ x ⦂ NO_SIMP φProd T U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜)
  ≡ Trueprop (Ant ⟶ C2 ⟶ C ⟶ (x ⦂ T ∗ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P) @tag 𝒜) ›
  unfolding atomize_imp Action_Tag_def NO_SIMP_def .

private lemma φTA_MDU_rewr_pre:
  ‹ (Ant ⟹ C2 ⟹ C ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ NO_SIMP φProd T U 𝗐𝗂𝗍𝗁 P @tag 𝒜)
  ≡ Trueprop (Ant ⟶ C2 ⟶ C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T ∗ U 𝗐𝗂𝗍𝗁 P) @tag 𝒜) ›
  unfolding atomize_imp Action_Tag_def NO_SIMP_def .

ML_file ‹library/phi_type_algebra/semimodule_distrib_zip.ML›

end

φproperty_deriver Module_Distr_HomoZ 130 for (‹Module_Distr_HomoZ _ _ _ _›)
    = ‹Phi_Type_Derivers.semimodule_distrib_zip›

φproperty_deriver Module_Distr_HomoS 130 for (‹Module_Distr_HomoS _ _ _ _›)
    = ‹Phi_Type_Derivers.semimodule_distrib_unzip›

φproperty_deriver Module_Distr_Homo 131
  requires Module_Distr_HomoZ and Module_Distr_HomoS

φproperty_deriver Semimodule_NonAssoc 132
  requires Module_Distr_Homo and Module_Zero
       and Module_One

φproperty_deriver Semimodule_no0 133
  requires Module_Assoc and Module_One
       and Module_Distr_Homo

φproperty_deriver Semimodule 134
  requires Semimodule_no0 and Module_Zero

(*
declare Is_Invariant[where PC=‹Module_Distr_HomoZ›, φreason default %φTA_guesser_assigning_variant]
        Is_Invariant[where PC=‹Module_Distr_HomoS›, φreason default %φTA_guesser_assigning_variant]
*)


subsection ‹Construct Abstraction from Concrete Representation (by Itself)›

(*Designed only for primitives, so can be buggy for advanced and particularly recursive φ-types*)

context begin

private lemma φTA_TrCstr_rule:
  ‹ Ant ⟶ (c ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A) @tag φTA_subgoal undefined
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ c ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A ›
  unfolding Action_Tag_def
  by simp

ML_file ‹library/phi_type_algebra/constr_abst_weak.ML›

end

φproperty_deriver Make_Abstraction_from_Raw 130
  for ( ‹∀x. Premise _ _ ⟶ (x ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?f x ⦂ ?T)›
      | ‹Premise _ _ ⟶ (?x ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y ⦂ ?T)›
      | ‹∀x. x ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?f x ⦂ ?T›
      | ‹?x ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y ⦂ ?T› )
  requires Warn_if_contains_Sat
    = ‹ Phi_Type_Derivers.Make_Abstraction_from_Raw ›



subsection ‹Destruct Abstraction down to Concrete Representation (by Itself)›

(*Designed only for primitives, so can be buggy for advanced and particularly recursive φ-types*)

context begin

private lemma φTA_TrRA_rule:
  ‹ (⋀x. Ant ⟶ (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Itself 𝗌𝗎𝖻𝗃 y. r x y) @tag φTA_subgoal (to (Itself::('b,'b) φ)))
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ ∀x. (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y::'b) ⦂ Itself 𝗌𝗎𝖻𝗃 y. r x y @tag to (Itself::('b,'b) φ)) ›
  unfolding Action_Tag_def
  by simp

private lemma φTA_TrRA_simp:
  ‹ ∀x. (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y::'b) ⦂ Itself 𝗌𝗎𝖻𝗃 y. r x y @tag to (Itself::('b,'b) φ))
 ⟹ Abstract_Domain T P
 ⟹ (⋀x y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P x ⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' x y : r x y )
 ⟹ ∀x. (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y::'b) ⦂ Itself 𝗌𝗎𝖻𝗃 y. r' x y @tag to (Itself::('b,'b) φ)) ›
  unfolding Transformation_def Action_Tag_def Satisfiable_def Simplify_def
            Abstract_Domain_def Premise_def 𝗋EIF_def
  by (clarsimp, smt (verit, del_insts))

ML_file ‹library/phi_type_algebra/open_all_abstraction.ML›

end

φproperty_deriver Open_Abstraction_to_Raw 130 for ( ‹∀x. (x ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Itself 𝗌𝗎𝖻𝗃 y. ?r x y @tag to Itself)›
                                                | ‹∀x. x ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Itself 𝗌𝗎𝖻𝗃 y. ?r x y @tag to Itself›
                                                | ‹?x ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Itself 𝗌𝗎𝖻𝗃 y. ?r' y @tag to Itself›)
  requires Warn_if_contains_Sat
    = ‹ Phi_Type_Derivers.open_all_abstraction ›

φproperty_deriver Abstraction_to_Raw 131
  requires Open_Abstraction_to_Raw and Make_Abstraction_from_Raw


subsection ‹Trim Empty Generated during Separation Extraction›

(*TODO: reform.*)

text ‹For a type operator ‹F›, SE_Trim_Empty generates rules that eliminates into ‹○›
  any ‹F ○› generated during Separation Extraction process.

  This elimination is derived from ‹Identity_Element›. If the elimination rule is condition-less
  (demand no conditional premise nor reasoner subgoals), the rule is activated automatically.
  But if there are conditions, the system needs user's discretion to decide if to activate it.
  If so, activate deriver ‹SE_Trim_Empty›.
›

lemma [φreason_template name F.φNone [unfolded Premise_def, assertion_simps, simp]]:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ TERM (Identity_ElementsI (F ○))
⟹ Identity_ElementsI (F ○) DI PI @tag 𝒜_template_reason undefined
⟹ Identity_ElementsE (F ○) DE @tag 𝒜_template_reason undefined
⟹ Abstract_Domain (F ○) PD @tag 𝒜_template_reason undefined
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 (∀x. (PD x ⟶ DI x) ∧ DE x)
⟹ NO_SIMP (F ○ = ○) ›
  unfolding Object_Equiv_def Identity_ElementI_def Identity_ElementE_def NO_SIMP_def Action_Tag_def
            Identity_ElementsI_def Identity_ElementsE_def Premise_def Abstract_Domain_def 𝗋EIF_def
            Satisfiable_def
  apply (rule φType_eqI_Tr; clarsimp simp: Transformation_def)
  by meson

(* Temporarily disabled, and I am thinking if to depreciate this module as it seems useless now.

lemma derive_𝒜SE_trim_I:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementI (yy ⦂ F ○) P
⟹ Object_Equiv (F ○) eq
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq (snd y) yy
⟹ 𝒜SE_trimI y (F ○) (fst y, ()) ○ P ›
  unfolding 𝒜SE_trimI_def
  ❴ premises _ and R1[unfolded Identity_ElementI_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .

lemma derive_𝒜SE_trim_I_TH:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementI (yy ⦂ F ○) P
⟹ Object_Equiv (F ○) eq
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq (snd y) yy
⟹ 𝒜SE_trimI_TH y (F ○) (fst y, ()) ○ P ○ (F' ○) ›
  unfolding 𝒜SE_trimI_TH_def
  ❴ premises _ and  R1[unfolded Identity_ElementI_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .

lemma derive_𝒜SE_trim_E:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementE (u ⦂ F ○)
⟹ 𝒜SE_trimE (fst x', u) (F ○) x' ○ ›
  unfolding 𝒜SE_trimE_def
  ❴ premises _ and R1[unfolded Identity_ElementE_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .

lemma derive_𝒜SE_trim_E_TH:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementE (u ⦂ F ○)
⟹ 𝒜SE_trimE_TH (fst x', u) (F ○) x' ○ ○ (F' ○) ›
  unfolding 𝒜SE_trimE_TH_def
  ❴ premises _ and R1[unfolded Identity_ElementE_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .


ML_file ‹library/phi_type_algebra/SE_Trim_Empty.ML›

φproperty_deriver SE_Trim_Empty 110
    = ‹fn quiet => K (Phi_Type_Derivers.SE_Trim_Empty quiet) ›

lemmas [φreason_template default 40 pass: ‹(Phi_Type_Derivers.SE_Trim_Empty__generation_pass, K I)›] =
          derive_𝒜SE_trim_I derive_𝒜SE_trim_I_TH
          derive_𝒜SE_trim_E derive_𝒜SE_trim_E_TH
*)

subsection ‹Meta Deriver for φ-Type Operator Commutativity›

paragraph ‹Guess Property›

subparagraph ‹Definition of Reasoning Goals›

definition Guess_Tyops_Commute :: ‹ bool ― ‹Intro for true, Elim for false›
                                ⇒ (('cF,'aF) φ ⇒ ('c,'a) φ)
                                ⇒ (('cT,'aT) φ ⇒ ('cG,'aG) φ)
                                ⇒ (('cT,'aT) φ ⇒ ('cF,'aF) φ)
                                ⇒ (('cG,'aG) φ ⇒ ('c,'b) φ)
                                ⇒ (('cF,'aF) φ ⇒ ('c,'a) φ)
                                ⇒ (('cT,'aT) φ ⇒ ('cG,'aG) φ)
                                ⇒ (('cT,'aT) φ ⇒ ('cF,'aF) φ)
                                ⇒ (('cG,'aG) φ ⇒ ('c,'b) φ)
                                ⇒ ('cT,'aT) φ
                                ⇒ ('a ⇒ bool)
                                ⇒ ('a ⇒ 'b ⇒ bool)
                                ⇒ bool ⇒ bool
                                ⇒ bool›
  where ‹Guess_Tyops_Commute is_intro G G' F F' unfolded_G unfolded_G' uF uF' T D r ants conds ≡ True›

definition Guess_Tyops_Commute1_2 :: ‹ bool ― ‹True for ‹1→2I›, False for ‹2→1I››
                                    ⇒ (('cG,'aG) φ ⇒ ('c,'a) φ)
                                    ⇒ (('cT,'aT) φ ⇒ ('cFT,'aFT) φ)
                                    ⇒ (('cU,'aU) φ ⇒ ('cFU,'aFU) φ)
                                    ⇒ (('cT,'aT) φ ⇒ ('cU,'aU) φ ⇒ ('cG,'aG) φ)
                                    ⇒ (('cFT,'aFT) φ ⇒ ('cFU,'aFU) φ ⇒ ('c,'b) φ)
                                    ⇒ (('cG,'aG) φ ⇒ ('c,'a) φ)
                                    ⇒ (('cT,'aT) φ ⇒ ('cFT,'aFT) φ)
                                    ⇒ (('cU,'aU) φ ⇒ ('cFU,'aFU) φ)
                                    ⇒ (('cT,'aT) φ ⇒ ('cU,'aU) φ ⇒ ('cG,'aG) φ)
                                    ⇒ (('cFT,'aFT) φ ⇒ ('cFU,'aFU) φ ⇒ ('c,'b) φ)
                                    ⇒ ('cT,'aT) φ
                                    ⇒ ('cU,'aU) φ
                                    ⇒ ('b ⇒ bool)
                                    ⇒ ('b ⇒ 'a ⇒ bool)
                                    ⇒ bool ⇒ bool
                                    ⇒ bool›
  where ‹Guess_Tyops_Commute1_2 mode F F'T F'U G G' uF uF'T uF'U uG uG' T U D r ants conds ≡ True›
    ― ‹also covers ‹Guess_Tyops_Commute2_1I›, by swapping ‹F› and ‹G››

definition Guess_Tyops_Commute2_1 :: ‹ bool ― ‹True for ‹1→2E›, False for ‹2→1E››
                                   ⇒ (('cG,'aG) φ ⇒ ('c,'a) φ)
                                   ⇒ (('cT,'aT) φ ⇒ ('cFT,'aFT) φ)
                                   ⇒ (('cU,'aU) φ ⇒ ('cFU,'aFU) φ)
                                   ⇒ (('cT,'aT) φ ⇒ ('cU,'aU) φ ⇒ ('cG,'aG) φ)
                                   ⇒ (('cFT,'aFT) φ ⇒ ('cFU,'aFU) φ ⇒ ('c,'b) φ)
                                   ⇒ (('cG,'aG) φ ⇒ ('c,'a) φ)
                                   ⇒ (('cT,'aT) φ ⇒ ('cFT,'aFT) φ)
                                   ⇒ (('cU,'aU) φ ⇒ ('cFU,'aFU) φ)
                                   ⇒ (('cT,'aT) φ ⇒ ('cU,'aU) φ ⇒ ('cG,'aG) φ)
                                   ⇒ (('cFT,'aFT) φ ⇒ ('cFU,'aFU) φ ⇒ ('c,'b) φ)
                                   ⇒ ('cT,'aT) φ
                                   ⇒ ('cU,'aU) φ
                                   ⇒ ('a ⇒ bool)
                                   ⇒ ('a ⇒ 'b ⇒ bool)
                                   ⇒ bool ⇒ bool
                                   ⇒ bool›
  where ‹Guess_Tyops_Commute2_1 mode F F'T F'U G G' uF uF'T uF'G uG uG' T U D r ants conds ≡ True›


φreasoner_group guess_tyop_commute_all = (100,[10,3000]) for (‹Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds›)
    ‹Rules guessing the form of the Commutativity between φ-Type Operators›
 and guess_tyop_commute = (1000, [1000, 3000]) for (‹Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds›)
                                             in guess_tyop_commute_all
    ‹User Rules›
 and guess_tyop_commute_fallback = (10, [10,10]) for (‹Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds›)
                                                  in guess_tyop_commute_all < guess_tyop_commute
    ‹Fallback rules›
 and guess_tyop_commute_default = (15, [11, 39]) for (‹Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds›)
                                                  in guess_tyop_commute_all and > guess_tyop_commute_fallback and < guess_tyop_commute
    ‹Predefined default rules guessing the form of the Commutativity between φ-Type Operators›

declare [[
  φreason_default_pattern ‹Guess_Tyops_Commute ?mode ?F _ ?G _ ?uG ?uG' ?uF ?uF' _ _ _ _ _› ⇒
                          ‹Guess_Tyops_Commute ?mode ?F _ ?G _ ?uG ?uG' ?uF ?uF' _ _ _ _ _›    (100)
                      and ‹Guess_Tyops_Commute1_2 ?mode ?F _ _ ?G _ ?uF ?uFT ?uFF ?uG ?uG' _ _ _ _ _ _› ⇒
                          ‹Guess_Tyops_Commute1_2 ?mode ?F _ _ ?G _ ?uF ?uFT ?uFF ?uG ?uG' _ _ _ _ _ _›    (100)
                      and ‹Guess_Tyops_Commute2_1 ?mode ?G _ _ ?F _ ?uG ?uGT ?uGF ?uF ?uF' _ _ _ _ _ _› ⇒
                          ‹Guess_Tyops_Commute2_1 ?mode ?G _ _ ?F _ ?uG ?uGT ?uGF ?uF ?uF' _ _ _ _ _ _›    (100)
]]

subparagraph ‹Initialization›

lemma [φreason %guess_tyop_commute_default for ‹Guess_Tyops_Commute _ _ ?var_F' _ _ _ _ _ _ _ _ _ _ _›]:
  ‹ Parameter_Variant_of_the_Same_Type F var_F'
⟹ Guess_Tyops_Commute Any F var_F' G G' uF uF' uG uG' T D r ants conds
⟹ Guess_Tyops_Commute Any F var_F' G G' uF uF' uG uG' T D r ants conds › .

lemma [φreason %guess_tyop_commute_default for ‹Guess_Tyops_Commute _ _ _ _ ?var_G' _ _ _ _ _ _ _ _ _›]:
  ‹ Parameter_Variant_of_the_Same_Type G var_G'
⟹ Guess_Tyops_Commute Any F F' G var_G' uF uF' uG uG' T D r ants conds
⟹ Guess_Tyops_Commute Any F F' G var_G' uF uF' uG uG' T D r ants conds› .

lemma [φreason %φTA_guesser_init except ‹Guess_Tyops_Commute True _ _ _ ?var_F' _ _ _ _ _ _ _ _ _›
                                         ‹Guess_Tyops_Commute True _ ?var_G' _ _ _ _ _ _ _ _ _ _ _›]:
  ‹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T x) : (x ⦂ G T) )
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G' T x) : (x ⦂ G' T) )
⟹ Guess_Tyops_Commute True G G' F F' var_unfolded_G var_unfolded_G' uF uF' T D r ants conds
⟹ Guess_Tyops_Commute True G G' F F' var_unfolded_G var_unfolded_G' uF uF' T D r ants conds› .

lemma [φreason %φTA_guesser_init except ‹Guess_Tyops_Commute False _ _ _ ?var_G' _ _ _ _ _ _ _ _ _›
                                        ‹Guess_Tyops_Commute False _ ?var_F' _ _ _ _ _ _ _ _ _ _ _›]:
  ‹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T x) : (x ⦂ G T) )
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G' T x) : (x ⦂ G' T) )
⟹ Guess_Tyops_Commute False F F' G G' uF uF' var_unfolded_G var_unfolded_G' T D r ants conds
⟹ Guess_Tyops_Commute False F F' G G' uF uF' var_unfolded_G var_unfolded_G' T D r ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ Parameter_Variant_of_the_Same_Type F F'T
⟹ Parameter_Variant_of_the_Same_Type F F'U
⟹ Parameter_Variant_of_the_Same_Type G G'
⟹ (⋀T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T U x) : (x ⦂ G T U) )
⟹ (⋀T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G' T U x) : (x ⦂ G' T U) )
⟹ Guess_Tyops_Commute1_2 True F F'T F'U G G' uF uF'T uF'U var_unfolded_G var_unfolded_G' T U D r ants conds
⟹ Guess_Tyops_Commute1_2 True F F'T F'U G G' uF uF'T uF'U var_unfolded_G var_unfolded_G' T U D r ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ Parameter_Variant_of_the_Same_Type F F'
⟹ Parameter_Variant_of_the_Same_Type G G'T
⟹ Parameter_Variant_of_the_Same_Type G G'U
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T x) : (x ⦂ G T) )
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G'T T x) : (x ⦂ G'T T) )
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G'U T x) : (x ⦂ G'U T) )
⟹ Guess_Tyops_Commute1_2 False G G'T G'U F F' var_unfolded_G var_unfolded_G'T var_unfolded_G'U uF uF' T U D r ants conds
⟹ Guess_Tyops_Commute1_2 False G G'T G'U F F' var_unfolded_G var_unfolded_G'T var_unfolded_G'U uF uF' T U D r ants conds› .


lemma [φreason %φTA_guesser_init]:
  ‹ Parameter_Variant_of_the_Same_Type F F'T
⟹ Parameter_Variant_of_the_Same_Type F F'U
⟹ Parameter_Variant_of_the_Same_Type G G'
⟹ (⋀T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG T U x) : (x ⦂ G T U) )
⟹ (⋀T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG' T U x) : (x ⦂ G' T U) )
⟹ Guess_Tyops_Commute2_1 True F F'T F'U G G' uF uF'T uF'U var_uG var_uG' T U D r ants conds
⟹ Guess_Tyops_Commute2_1 True F F'T F'U G G' uF uF'T uF'U var_uG var_uG' T U D r ants conds› .

lemma [φreason %φTA_guesser_init]:
  ‹ Parameter_Variant_of_the_Same_Type F F'
⟹ Parameter_Variant_of_the_Same_Type G G'T
⟹ Parameter_Variant_of_the_Same_Type G G'U
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG T x) : (x ⦂ G T) )
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG'T T x) : (x ⦂ G'T T) )
⟹ (⋀T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG'U T x) : (x ⦂ G'U T) )
⟹ Guess_Tyops_Commute2_1 False G G'T G'U F F' var_uG var_uG'T var_uG'U uF uF' T U D r ants conds
⟹ Guess_Tyops_Commute2_1 False G G'T G'U F F' var_uG var_uG'T var_uG'U uF uF' T U D r ants conds› .


subparagraph ‹Default Rules›

lemma [φreason %guess_tyop_commute_fallback for ‹Guess_Tyops_Commute _ _ _ _ _ _ _ _ _ _ _ _ _ _›]:
  ‹ Type_Variant_of_the_Same_Type_Operator F F' ∨cut True
⟹ Type_Variant_of_the_Same_Type_Operator G G' ∨cut True
⟹ Guess_Tyops_Commute both F F' G G' uF uF' any any' T (λ_. True) (embedded_func (λx. x) (λ_. True)) True True›
  unfolding Guess_Tyops_Commute_def ..

lemma [φreason %guess_tyop_commute_fallback for ‹Guess_Tyops_Commute2_1 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _›]:
  ‹ Type_Variant_of_the_Same_Type_Operator2 F F' ∨cut True
⟹ Type_Variant_of_the_Same_Type_Operator G G'T ∨cut True
⟹ Type_Variant_of_the_Same_Type_Operator G G'U ∨cut True
⟹ Guess_Tyops_Commute2_1 both G G'T G'U F F' uG uG'T uG'U uF uF' T U
                          (λ_. True) (embedded_func (λx. x) (λ_. True)) True True ›
  unfolding Guess_Tyops_Commute2_1_def ..

lemma [φreason %guess_tyop_commute_fallback for ‹Guess_Tyops_Commute1_2 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _›]:
  ‹ Type_Variant_of_the_Same_Type_Operator2 G G' ∨cut True
⟹ Type_Variant_of_the_Same_Type_Operator F F'T ∨cut True
⟹ Type_Variant_of_the_Same_Type_Operator F F'U ∨cut True
⟹ Guess_Tyops_Commute1_2 both F F'T F'U G G' uF uF'T uF'U uG uG' T U
                               (λ_. True) (embedded_func (λx. x) (λ_. True)) True True ›
  unfolding Guess_Tyops_Commute1_2_def ..


subparagraph ‹ML›

ML_file ‹library/phi_type_algebra/guess_tyops_commute.ML›


subparagraph ‹Templates›

context begin

private lemma Guess_Tyops_Commute_by_unfolding_1:
  ‹ (⋀T x. A T x = A' T x)
⟹ Guess_Tyops_Commute mode G G' F F' uG uG' A' uF' T D R a c
⟹ Guess_Tyops_Commute mode G G' F F' uG uG' A  uF' T D R a c ›
  by presburger

private lemma Guess_Tyops_Commute_by_unfolding_2:
  ‹ (⋀T x. A T x = A' T x)
⟹ Guess_Tyops_Commute mode G G' F F' uG uG' uF A' T D R a c
⟹ Guess_Tyops_Commute mode G G' F F' uG uG' uF A  T D R a c ›
  by presburger

private lemma Guess_Tyops_Commute_by_unfolding_3:
  ‹ (⋀T x. A T x = A' T x)
⟹ Guess_Tyops_Commute mode G G' F F' A' uG' uF uF' T D R a c
⟹ Guess_Tyops_Commute mode G G' F F' A  uG' uF uF' T D R a c ›
  by presburger

private lemma Guess_Tyops_Commute_by_unfolding_4:
  ‹ (⋀T x. A T x = A' T x)
⟹ Guess_Tyops_Commute mode G G' F F' uG A' uF uF' T D R a c
⟹ Guess_Tyops_Commute mode G G' F F' uG A  uF uF' T D R a c ›
  by presburger+

lemmas Guess_Tyops_Commute_by_unfolding =
          Guess_Tyops_Commute_by_unfolding_1 Guess_Tyops_Commute_by_unfolding_2
          Guess_Tyops_Commute_by_unfolding_3 Guess_Tyops_Commute_by_unfolding_4

end


subparagraph ‹Deriving Bubbling ToA›



(*
subparagraph ‹Rules›

lemma [φreason %object_equiv_cut]:
  ‹ Object_Equiv T eq
⟹ Object_Equiv (𝗁𝖺𝗌-𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) eq›
  unfolding Has_Bubbling_def .

lemma [φreason %object_equiv_cut]:
  ‹ Object_Equiv T eq
⟹ Object_Equiv (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) eq›
  unfolding Bubbling_def .

lemma [φreason %identity_element_cut]:
  ‹ Identity_ElementsI T D P
⟹ Identity_ElementsI (𝗁𝖺𝗌-𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) D P ›
  unfolding Has_Bubbling_def .

lemma [φreason %identity_element_cut]:
  ‹ Identity_ElementsE T D
⟹ Identity_ElementsE (𝗁𝖺𝗌-𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) D ›
  unfolding Has_Bubbling_def .
*)

paragraph ‹Deriver›

φreasoner_group derived_commutativity_deriver = (150, [150, 151 ]) for ‹_›
    ‹The priority of derived deriver for commutativity between type operators›

(*F is fixed myself, G is the target
  Given ‹F›, generate derivers deriving ‹Tyops_Commute F F' G G' T D r›
  and ‹Tyops_Commute G G' F F' T D r› for given G
*)

lemma φTA_TyCommI_gen:
  ‹ Parameter_Variant_of_the_Same_Type F F'
⟹ 𝗋Success ―‹Success of generating deriving rule›
⟹ (⋀x. Ant ⟶
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟶
          (x ⦂ OPEN undefined (G (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F T))
          𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F' (MAKE undefined (G' T)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal 𝒜simp)
          ―‹^ target of inductive expansion, needs ‹to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 G F)››
          ―‹The ‹OPEN› tag restricts the deriver to only unfold what should be unfolded,
             especially when reasoning the commutativity between one φ-type and itself.›
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Tyops_Commute G G' F F' T D r›
  unfolding Action_Tag_def Tyops_Commute_def Premise_def Bubbling_def MAKE_def OPEN_def
  by blast

lemma φTA_TyCommE_gen:
  ‹ Parameter_Variant_of_the_Same_Type F F'
⟹ 𝗋Success ―‹Success of generating deriving rule›
⟹ (⋀x. Ant ⟶
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟶
           (x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (OPEN undefined (G T))
            𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined (G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F' T)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Tyops_Commute F F' G G' T D r›
  unfolding Action_Tag_def Tyops_Commute_def Premise_def embedded_func_def Bubbling_def OPEN_def MAKE_def
  by clarsimp
  

lemma φTA_TyComm1_2I_gen:
  ‹ Parameter_Variant_of_the_Same_Type F F'T
⟹ Parameter_Variant_of_the_Same_Type F F'U
⟹ 𝗋Success ―‹Success of generating deriving rule›
⟹ (⋀x. Ant ⟶
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟶
          (x ⦂ OPEN undefined (G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U))
           𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F (MAKE undefined (G T U)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal 𝒜simp)
          ―‹^ target of inductive expansion, needs ‹to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 G F)››
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Tyops_Commute2_1 F F'T F'U G G' T U D r›
  unfolding Action_Tag_def Tyops_Commute2_1_def Premise_def Bubbling_def OPEN_def MAKE_def
  by blast

lemma φTA_TyComm1_2E_gen:
  ‹ Parameter_Variant_of_the_Same_Type F F'T
⟹ Parameter_Variant_of_the_Same_Type F F'U
⟹ 𝗋Success ―‹Success of generating deriving rule›
⟹ (⋀x. Ant ⟶
       𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟶
        (x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (OPEN undefined (G T U))
         𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined (G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U)) 𝗌𝗎𝖻𝗃 y. r x y)
                      ―‹^ target of inductive expansion. The same limitation as above.›
       @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Tyops_Commute1_2 F F'T F'U G G' T U D r›
  unfolding Action_Tag_def Tyops_Commute1_2_def Premise_def embedded_func_def OPEN_def MAKE_def Bubbling_def
  by clarsimp

lemma φTA_TyComm2_1I_gen:
  ‹ Parameter_Variant_of_the_Same_Type F F'
⟹ 𝗋Success ―‹Success of generating deriving rule›
⟹ (⋀x. Ant ⟶
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟶
          (x ⦂ OPEN undefined (G (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F T U))
            ―‹^ target of inductive expansion, needs ‹to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 G F)››
           𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F' (MAKE undefined (G'T T)) (MAKE undefined (G'U U)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal 𝒜simp)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Tyops_Commute1_2 G G'T G'U F F' T U D r›
  unfolding Action_Tag_def Tyops_Commute1_2_def Premise_def Bubbling_def OPEN_def MAKE_def
  by clarsimp

lemma φTA_TyComm2_1E_gen:
  ‹ Parameter_Variant_of_the_Same_Type F F'
⟹ 𝗋Success ―‹Success of generating deriving rule›
⟹ (⋀x. Ant ⟶
       𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x ⟶
        (x ⦂ 𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F' (OPEN undefined (G'T T)) (OPEN undefined (G'U U))
         𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ MAKE undefined (G (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F T U)) 𝗌𝗎𝖻𝗃 y. r x y)
                     ―‹^ target of inductive expansion. The same limitation as above.›
       @tag φTA_subgoal undefined)
⟹ 𝗋Success
⟹ 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
⟹ Ant @tag φTA_ANT
⟹ Tyops_Commute2_1 G G'T G'U F F' T U D r›
  unfolding Action_Tag_def Tyops_Commute2_1_def Premise_def embedded_func_def OPEN_def MAKE_def Bubbling_def
  by clarsimp

(*TODO: bi-commutativity!*)

ML_file ‹library/phi_type_algebra/gen_tyops_commute.ML›

φproperty_deriver Commutativity_DeriverI 200
    = ‹fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (false, 1) quiet) ›

φproperty_deriver Commutativity_DeriverE 200
    = ‹fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (false, 2) quiet) ›

φproperty_deriver Commutativity_Deriver 200
    = ‹fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (false, 3) quiet) ›

φproperty_deriver Commutativity_DeriverI_rev 200
    = ‹fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (true, 2) quiet) ›
  ― ‹The name is reversed, i.e., I for E, E for I, but the deriving process is unchanged.›

φproperty_deriver Commutativity_DeriverE_rev 200
    = ‹fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (true, 1) quiet) ›

φproperty_deriver Commutativity_Deriver_rev 200
    = ‹fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (true, 3) quiet) ›



section ‹Deriving Configures for Specific Abstract Algebras›

subsubsection ‹Common›

lemmas [φderiver_simps] =
  Nat.add_Suc_right Groups.monoid_add_class.add.right_neutral Nat.nat.inject

lemmas [φderiver_simps] =
  Basic_BNFs.prod_set_defs

declare option.rel_eq[iff] option.pred_True[iff]

subsubsection ‹List›

declare list.rel_eq[iff] list.pred_True[iff]

(*definition ‹zip' = case_prod zip›*)
setup ‹Sign.mandatory_path "list"›
abbreviation ‹unzip l ≡ (map fst l, map snd l)›

lemma case_unzip[simp]:
  ‹(case list.unzip x of (a,b) ⇒ f a b) = (let a = map fst x; b = map snd x in f a b)›
  by simp

(*deprecated
lemma zip'_inj[iff]:
  ‹length (fst l) = length (snd l) ⟹ map fst (zip' l) = fst l›
  ‹length (fst l) = length (snd l) ⟹ map snd (zip' l) = snd l›
  unfolding zip'_def
  by (cases l; simp)+*)

lemma zip_unzip[iff]:
  ‹ case_prod zip (list.unzip l) = l ›
  by (simp add: zip_map_fst_snd)

lemma unzip_zip[iff]:
  ‹ length x = length y
⟹ list.unzip (zip x y) = (x,y) ›
  by simp

lemma zip_eq_Cons_ex:
  ‹zip x y = (h#l) ⟷ (∃ah al bh bl. x = ah # al ∧ y = bh # bl ∧ (ah,bh) = h ∧ zip al bl = l)›
  by (simp, induct_tac y; case_tac x; simp)

lemma zip_eq_Nil_eq_len:
  ‹length x = length y ⟹ (zip x y = []) ⟷ x = [] ∧ y = []›
  by (simp; induct x; cases y; simp)

lemma zip_eq_Nil_with_rel:
  ‹list_all2 P a b ∧ zip a b = [] ⟷ a = [] ∧ b = []›
  by (induct b; cases a; simp)

setup ‹Sign.parent_path›


lemma map_prod_case_analysis:
  ‹map (λx. (f x, g x)) la = lb ≡ map f la = map fst lb ∧ map g la = map snd lb ›
  by (induct la arbitrary: lb; clarsimp; fastforce)

lemma list_all2__const_True[simp]:
  ‹list_all2 (λx y. True) = (λx y. length x = length y)›
  apply (clarsimp simp add: fun_eq_iff)
  subgoal for x y
  by (induct x arbitrary: y; simp; case_tac y; simp) .

(*
setup ‹ Context.theory_map(
  BNF_FP_Sugar_More.add_fp_more (type_name‹list›, {
      deads = [],
      lives = [typ‹'a›],
      lives'= [typ‹'b›],
      zip = term‹zip'›,
      unzip = Const‹unzip' typ‹'a› typ‹'b››,
      zip_simps = @{thms' zip'_inj zip'_eq_Cons_ex zip'_eq_Cons_ex zip'_eq_Nil_eq_len
                          length_map length_zip' zip'_map
                          unzip'_inj unzip'_prj map_prod_case_analysis}
  }))
›
*)

term ‹list.unzip :: ('a × 'b) list ⇒ 'a list × 'b list›

setup ‹ Context.theory_map(
  BNF_FP_Sugar_More.add_fp_more (type_name‹list›, {
      deads = [],
      lives = [typ‹'a›],
      lives'= [typ‹'b›],
      zip = term‹case_prod zip :: 'a list × 'b list ⇒ ('a × 'b) list›,
      unzip = term‹list.unzip :: ('a × 'b) list ⇒ 'a list × 'b list›,
      zip_simps = @{thms' list.zip_unzip list.unzip_zip list.zip_eq_Cons_ex list.zip_eq_Nil_eq_len
                          length_map length_zip zip_map1 zip_map2 zip_map_fst_snd
                          List.zip_map_fst_snd map_zip_map map_zip_map2
                          map_prod_case_analysis}
  }))
›

lemma list_all2_reduct_rel[simp]:
  ‹list_all2 (λa b. b = f a ∧ P a) = (λa' b'. b' = map f a' ∧ list_all P a')›
  apply (clarsimp simp add: fun_eq_iff)
  subgoal for x y by (induct x arbitrary: y; simp; case_tac y; simp; blast) .

lemmas [φderiver_simps] =
  list.size map_eq_Cons_conv list_all2_lengthD[THEN HOL.Eq_TrueI]

paragraph ‹Separatable Mappers›

lemma [φreason add]:
  ‹compositional_mapper map map map UNIV f g›
  unfolding compositional_mapper_def
  by clarsimp

lemma [φreason add]:
  ‹separatable_unzip (case_prod zip) list.unzip UNIV map map map f g›
  unfolding separatable_unzip_def
  by (clarsimp simp add: zip_eq_conv)

lemma [φreason add]:
  ‹separatable_zip list.unzip (case_prod zip) {(la,lb). length la = length lb} map map map f g›
  unfolding separatable_zip_def
  by (clarsimp simp add: zip_eq_conv, metis map_fst_zip map_map map_snd_zip)

lemma [φreason add]:
  ‹domain_by_mapper set map set f UNIV›
  unfolding domain_by_mapper_def
  by clarsimp

lemma [φreason add]:
  ‹domain_of_inner_map map set›
  unfolding domain_of_inner_map_def
  by clarsimp


subsubsection ‹Sum›

lemma pred_sum_eq_case_sum[φderiver_simps]:
  ‹pred_sum P Q x ⟷ case_sum P Q x›
  by (cases x; simp)

lemma collapse_case_sum[simp]:
  ‹(case x of Inl x ⇒ Inl x | Inr x ⇒ Inr x) = x›
  by (cases x; simp)


subsubsection ‹Set›

(*definition ‹zip_set = case_prod (×)›
definition ‹unzip_set s = (Domain s, Range s)› *)

lemma rel_set__const_True[simp]:
  ‹rel_set (λx y. True) = (λx y. x = {} ⟷ y = {})›
  by (clarsimp simp add: fun_eq_iff rel_set_def; blast)

setup ‹ Context.theory_map (eBNF_Info.add_BNF (type_name‹Set.set›, 
let val a = TFree ("a", sort‹type›)
    val b = TFree ("b", sort‹type›)
 in {
  T = Type‹Set.set a›,
  Tname = type_name‹Set.set›,
  casex = NONE,
  case_distribs = [],
  ctrs = [Const‹bot Type‹set a››, Const‹insert a›, Const‹sup Type‹set a››],
  deads = [], lives = [a], lives'= [b],
  sets = [Abs("x", Type‹Set.set a›, Bound 0)],
  set_thms = [],
  ctr_simps = [],
  rel = Const‹rel_set a b›,
  rel_simps = @{thms' Lifting_Set.empty_transfer rel_set__const_True},
  rel_eq = @{thm' rel_set_eq},
  pred = Abs("P", a --> HOLogic.boolT, Abs ("S", Type‹Set.set a›, Const‹Ball a› $ Bound 0 $ Bound 1)),
  pred_injects = @{thms' Set.ball_simps(5) Set.ball_Un Set.ball_simps(7)},
  pred_simps = @{thms' Set.ball_simps},
  map = Const‹Set.image a b›,
  map_thms = @{thms' Set.image_insert Set.image_Un Set.image_empty},
  map_disc_iffs = @{thms' image_is_empty},
  map_ident = @{thm' Set.image_ident},
  map_comp_of = @{thm' Set.image_image},
  fp_more = SOME {
    deads = [],
    lives = [a],
    lives'= [b],
    zip = term‹case_prod (×) :: 'a set × 'b set ⇒ ('a × 'b) set›,
    unzip = term‹(λs. (Domain s, Range s)) :: ('a × 'b) set ⇒ 'a set × 'b set›,
    zip_simps = []
  }
} end)
)›


lemmas [φderiver_simps] =
  Set.ball_Un Fun.bind_image Set.empty_bind Set.bind_singleton_conv_image
  Set.nonempty_bind_const Finite_Set.finite_bind

lemma Set_bind_insert[simp, φderiver_simps]:
  ‹Set.bind (insert x S) f = f x ∪ Set.bind S f›
  unfolding Set.bind_def
  by auto


subsubsection ‹Function›

definition ‹zip_fun = case_prod BNF_Def.convol›
definition ‹unzip_fun f = (fst o f, snd o f)›

lemma zip_fun_inj[simp]:
  ‹fst o (zip_fun f) = fst f›
  ‹snd o (zip_fun f) = snd f›
  unfolding zip_fun_def fun_eq_iff BNF_Def.convol_def
  by (cases f; clarsimp)+

lemma zip_fun_inj'[simp]:
  ‹fst (zip_fun f x) = fst f x›
  ‹snd (zip_fun f x) = snd f x›
  unfolding zip_fun_def fun_eq_iff BNF_Def.convol_def
  by (cases f; clarsimp)+

lemma zip_fun_map:
  ‹zip_fun (f o x, y) = apfst f o zip_fun (x, y)›
  ‹zip_fun (x, g o y) = apsnd g o zip_fun (x, y)›
  unfolding zip_fun_def BNF_Def.convol_def
  by clarsimp+

lemma zip_fun_prj[simp]:
  ‹fst (unzip_fun x) = fst o x›
  ‹snd (unzip_fun x) = snd o x›
  unfolding unzip_fun_def
  by clarsimp+

lemma map_fun_prod_case_analysis:
  ‹(λx. (f x, g x)) o a = b ≡ f o a = fst o b ∧ g o a = snd o b›
  unfolding atomize_eq fun_eq_iff
  by (clarsimp, rule, metis fst_eqD snd_conv, clarsimp)

setup ‹ Context.theory_map(
  let val (i, a, b) = (typ‹'i›, typ‹'a›, typ‹'b›)
   in BNF_FP_Sugar_More.add_fp_more (type_name‹fun›, {
        deads = [i], lives = [a], lives'= [b],
        zip = Const‹zip_fun i a b›,
        unzip = Const‹unzip_fun i a b›,
        zip_simps = @{thms' zip_fun_inj zip_fun_inj' zip_fun_map zip_fun_prj map_fun_prod_case_analysis}
  }) end)
›

lemma rel_fun__const_True[simp]:
  ‹rel_fun (=) (λx y. True) = (λx y. True)›
  by (simp add: fun_eq_iff rel_fun_def)

subsubsection ‹Option›

setup ‹ Context.theory_map(
  let val (a, b) = (typ‹'a›, typ‹'b›)
   in BNF_FP_Sugar_More.add_fp_more (type_name‹option›, {
        deads = [], lives = [a], lives'= [b],
        zip = Const‹zip_option a b›,
        unzip = Const‹unzip_option a b›,
        zip_simps = @{thms' zip_option_simps unzip_option_simps unzip_zip_option zip_option_prj}
  }) end)
›



subsubsection ‹Production›

lemma [φderiver_simps, simp]:
  ‹pred_prod (λa. True) P x ⟷ P (snd x)›
  ‹pred_prod Q (λa. True) x ⟷ Q (fst x)›
  by (cases x; simp)+

declare Lifting.pred_prod_beta[φgeneration_simp]

section ‹Clean-up›

hide_const (open) introduced




chapter ‹Typeclass›

ML_file ‹library/typeclass.ML›




end